More efficient macro

L

LEU

I have the following macro that works just fine, but I was wondering if there
is a more efficient way to write it?

Sub Pound()
Dim idx As Long, num As Long
Dim Pnd As Shape
Dim textbox As Shape
Dim aVar As Variant
On Error GoTo endthis

For Each aVar In ActiveDocument.Variables
If aVar.Name = "idx" Then
num = aVar.Index
Exit For
End If
Next aVar

If num = 0 Then
ActiveDocument.Variables.Add Name:="idx", Value:=0
End If

idx = ActiveDocument.Variables("idx").Value + 1
Select Case Selection.Style
Case ActiveDocument.Styles(wdStyleHeading1)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles(wdStyleHeading2)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles(wdStyleHeading3)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 60, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles(wdStyleHeading4)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
105, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles(wdStyleHeading5)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
133, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles(wdStyleHeading6)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
155, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles(wdStyleHeading7)
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
177, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B1")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B2")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B3")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 60, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B4")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
105, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B5")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
133, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B6")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
155, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx

Case ActiveDocument.Styles("B7")
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
177, _
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22, 24)
With Pnd.TextFrame.TextRange
.Text = "#"
.Font.Size = 12
End With
Pnd.Fill.Visible = msoFalse
Pnd.Line.Visible = msoFalse
Pnd.Name = "Pnd" & idx
ActiveDocument.Variables("idx").Value = idx
endthis:
End Select
End Sub
 
J

Jay Freedman

Write a subroutine that does the processing that you now do within each case
of the Select statement. Replace the code in each case with a call to that
subroutine, passing the idx value and the value for the left position of the
text box as arguments.

See http://www.word.mvps.org/FAQs/MacrosVBA/ProcArguments.htm.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.
 
L

LEU

Jay,

I'm not sure what to do. I look at the link you gave me but I not sure how
to make that work. My shape is placed at different locations depending on the
style of the paragraph. If the style is Heading1 or Hd1 or H1 the shape is
drawn at one spot. But if the style is Heading2 or Hd2 or H2 the shape is
drawn at a different spot. So in the long run wouldn't I end up with about
the same thing?
 
G

Greg Maxey

LEU,

What Jay is suggesting is that your Case statements are all doing pretty
much the same thing except a couple different values are used. Write one
ruouting to do the process and pass those values to it:


Sub Pound()
Dim idx As Long, num As Long
Dim aVar As Variant
On Error GoTo Err_Handler
For Each aVar In ActiveDocument.Variables
If aVar.Name = "idx" Then
num = aVar.Index
Exit For
End If
Next aVar
If num = 0 Then
ActiveDocument.Variables.Add Name:="idx", Value:=0
End If
idx = ActiveDocument.Variables("idx").Value + 1
Select Case Selection.Style
Case "Heading 1", "B1"
InsertSomething 25, idx
Case "Heading 2", "B2"
InsertSomething 25, idx
Case "Heading 3", "B3"
InsertSomething 60, idx
Case "Heading 4", "B4"
InsertSomething 105, idx
Case "Heading 5", "B5"
InsertSomething 133, idx
Case "Heading 6", "B6"
InsertSomething 155, idx
Case "Heading 7", "B7"
InsertSomething 177, idx
End Select
Exit Sub
Err_Handler:
MsgBox "This process terminated due to error: " & Err.Number & " " &
Err.Description
End Sub

Sub InsertSomething(ByRef i As Long, j As Long)
Dim Pnd As Shape
Set Pnd = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, i,
_
Selection.Information(wdVerticalPositionRelativeToPage) - 4, 22,
24)
With Pnd
.TextFrame.TextRange.Text = "#"
.TextFrame.TextRange.Font.Size = 12
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.Name = "Pnd" & j
End With
ActiveDocument.Variables("idx").Value = j
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Textbox help 2
Draw Table 4
Drawing shapes 3
Drawing lines 2
Shape size 4
Text Overflow 4
Place Text box at Mouse Pointer Position on a page 0
Adding Text Boxes to New Page 4

Top