E
Ed from AZ
I threw together a macro in Word 2007 yesterday, but it kept
interrupting. There was no error, but I'd get the annoying message
box that says "Code execution has been interrupted." and the CONTINUE,
END, and DEBUG buttons. I've learned this is usually an indication
that I'm stretching the capacity of my memory - all I have to do is
hit CONTINUE and it runs along just fine - until it interuupts again!!
I had tables in a Word doc with reprot numbers in one column, and
several more blank columns. The data to fill in those blanks was
mostly in an Excel spreadsheet. One blank, though, could only be
filled in by finding the report document and grabbing one line of
text.
So the macro was designed to set an object to the table I had selected
and iterate down the report numbers, open the spreadsheet and find the
needed values for that report, then open the report, grab the one line
of text, and close the report. Lather, rinse, repeat until the end of
the table.
Can someone see where I could have saved memory overhead and made this
run a bit smoother?
Ed
Sub EnterMyInfo()
Dim doc As Document
Dim tbl As Table
Dim str As String
Dim cll As Word.Cell
Dim tir As Document
Dim this As Range
Dim oXL As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim xlcll As Excel.Range
Dim x As Long, y As Long
Dim a As Long, b As Long
Dim vlu
Set doc = ActiveDocument
Set tbl = Selection.Tables(1)
Set oXL = New Excel.Application
Set wkb = oXL.Workbooks.Open("C:\MyFile.xls")
oXL.Visible = True
Set wks = wkb.Worksheets("Sheet1")
a = wks.Range("A20000").End(xlUp).Row
x = tbl.Rows.Count
For y = 1 To x
Application.StatusBar = "Row " & y & " of " & x
Set cll = tbl.Cell(y, 1)
If Left(cll.Range.Text, 5) = "L5-BB" Then
str = Left(cll.Range.Text, 10)
For b = 2 To a
If wks.Range("B" & b).Value = str Then Exit For
Next b
'Stop
'**********
'vlu was deliberately left undefined
'so I could adjust it depending on the table.
'**********
vlu = Format(wks.Cells(b, 3).Value, "mm/dd/yyyy")
tbl.Cell(y, 2).Range.Text = vlu
vlu = Format(wks.Cells(b, 5).Value, "####0.0")
tbl.Cell(y, 3).Range.Text = vlu
'tbl.Cell(y, 4).Range.Text = wks.Cells(b, 7).Value
Set tir = Word.Application.Documents.Open(FileName:="\\Server1\ &
str & ".doc")
tir.PageSetup.LeftMargin = InchesToPoints(0.75)
tir.PageSetup.RightMargin = InchesToPoints(0.75)
Set this = tir.Content
With this.Find
.Text = "|90. "
.Execute
this.Collapse wdCollapseEnd
this.MoveEndUntil "|", wdForward
tbl.Cell(y, 4).Range.Text = Trim(this.Text)
End With
'Stop
tir.Close wdDoNotSaveChanges
Set tir = Nothing
End If
Next y
EndMeNow:
On Error Resume Next
wkb.Close
oXL.Quit
Set oXL = Nothing
On Error GoTo 0
MsgBox "I'm done!"
End Sub
interrupting. There was no error, but I'd get the annoying message
box that says "Code execution has been interrupted." and the CONTINUE,
END, and DEBUG buttons. I've learned this is usually an indication
that I'm stretching the capacity of my memory - all I have to do is
hit CONTINUE and it runs along just fine - until it interuupts again!!
I had tables in a Word doc with reprot numbers in one column, and
several more blank columns. The data to fill in those blanks was
mostly in an Excel spreadsheet. One blank, though, could only be
filled in by finding the report document and grabbing one line of
text.
So the macro was designed to set an object to the table I had selected
and iterate down the report numbers, open the spreadsheet and find the
needed values for that report, then open the report, grab the one line
of text, and close the report. Lather, rinse, repeat until the end of
the table.
Can someone see where I could have saved memory overhead and made this
run a bit smoother?
Ed
Sub EnterMyInfo()
Dim doc As Document
Dim tbl As Table
Dim str As String
Dim cll As Word.Cell
Dim tir As Document
Dim this As Range
Dim oXL As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim xlcll As Excel.Range
Dim x As Long, y As Long
Dim a As Long, b As Long
Dim vlu
Set doc = ActiveDocument
Set tbl = Selection.Tables(1)
Set oXL = New Excel.Application
Set wkb = oXL.Workbooks.Open("C:\MyFile.xls")
oXL.Visible = True
Set wks = wkb.Worksheets("Sheet1")
a = wks.Range("A20000").End(xlUp).Row
x = tbl.Rows.Count
For y = 1 To x
Application.StatusBar = "Row " & y & " of " & x
Set cll = tbl.Cell(y, 1)
If Left(cll.Range.Text, 5) = "L5-BB" Then
str = Left(cll.Range.Text, 10)
For b = 2 To a
If wks.Range("B" & b).Value = str Then Exit For
Next b
'Stop
'**********
'vlu was deliberately left undefined
'so I could adjust it depending on the table.
'**********
vlu = Format(wks.Cells(b, 3).Value, "mm/dd/yyyy")
tbl.Cell(y, 2).Range.Text = vlu
vlu = Format(wks.Cells(b, 5).Value, "####0.0")
tbl.Cell(y, 3).Range.Text = vlu
'tbl.Cell(y, 4).Range.Text = wks.Cells(b, 7).Value
Set tir = Word.Application.Documents.Open(FileName:="\\Server1\ &
str & ".doc")
tir.PageSetup.LeftMargin = InchesToPoints(0.75)
tir.PageSetup.RightMargin = InchesToPoints(0.75)
Set this = tir.Content
With this.Find
.Text = "|90. "
.Execute
this.Collapse wdCollapseEnd
this.MoveEndUntil "|", wdForward
tbl.Cell(y, 4).Range.Text = Trim(this.Text)
End With
'Stop
tir.Close wdDoNotSaveChanges
Set tir = Nothing
End If
Next y
EndMeNow:
On Error Resume Next
wkb.Close
oXL.Quit
Set oXL = Nothing
On Error GoTo 0
MsgBox "I'm done!"
End Sub