F
funkymonkUK
Hi
I got a macro that produces 54 word documents which are linked to
workbook full of data. the macro runs perfectly except it does not see
to break the links between word and excel but only on certain tables an
graphs.
this is my code I have at the moment
Option Explicit
Sub runReports()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim rng As Word.Range
Dim cel As Object
Dim strStoreDoing As String
Dim sheet As Worksheet
Dim counter As Integer
'open word
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
'loop through cell Stores wanted
For Each cel In Range("todoStore") ' This is a list of stores whic
I want to produce
Sheets("main").Range("e16").Value = cel.Value
strStoreDoing = Sheets("main").Range("e17").Value
Application.ScreenUpdating = False
'miss certain stores
If (cel.Value + 0) > 1000 Then GoTo donotdoStore
'open word template
Set wrdDoc = wrdApp.Documents.Open(ThisWorkbook.Path
"\wrdStore.doc")
Set rng = wrdApp.ActiveDocument.Range
'Loop through sheets and autofilter the data according to which stor
you producing
For Each sheet In Sheets(Array("Sheet1", "sheet2", "sheet3", _
"sheet4"))
sheet.Select
Range("a1").Select
Selection.AutoFilter Field:=4, Criteria1:=strstoreDoing
Next sheet
'unlink fields
rng.Fields.Unlink
'unlink header and footers
' doHeadFoot
' wrdApp.ActiveDocument.Shapes("Text Box 22").Select
wrdApp.Selection.Fields.Unlink
'save as Store name
wrdDoc.SaveAs (ThisWorkbook.Path & "\reports\" & LCase(strCrtDoing
& " apr 2005 to mar 2006.doc")
wrdDoc.Close
'wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
' turn the Autofilters to All
For Each sheet In Sheets(Array("Sheet1", "sheet2", "sheet3", _
"sheet4"))
sheet.Select
Range("a1").Select
Selection.AutoFilter Field:=4
Next sheet
Application.ScreenUpdating = True
Sheets("main").Activate
Range("c13").Value = cel.Value
Next cel
donotdoStore:
Set wrdApp = Nothing
End Sub
Sub doHeadFoot()
Dim oField As Field
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim x As Integer
Dim z
For Each oSection In ActiveDocument.Sections
x = x + 1
If x = 1 Then GoTo missfirst:
For Each oHeader In oSection.Headers
If oHeader.Exists Then
If oHeader.Index = 0 Then GoTo missheader:
For Each oField In oHeader.Range.Fields
oField.Unlink
Next oField
missheader:
End If
Next oHeader
For Each oFooter In oSection.Footers
If oFooter.Exists Then
If oFooter.Index = 0 Then GoTo missfooter:
For Each oField In oFooter.Range.Fields
If Left(oField.Code, 5) = " LINK" Then oField.Unlink
Next oField
missfooter:
End If
Next oFooter
missfirst:
Next oSection
End Sub
Any help much appreciated
I got a macro that produces 54 word documents which are linked to
workbook full of data. the macro runs perfectly except it does not see
to break the links between word and excel but only on certain tables an
graphs.
this is my code I have at the moment
Option Explicit
Sub runReports()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim rng As Word.Range
Dim cel As Object
Dim strStoreDoing As String
Dim sheet As Worksheet
Dim counter As Integer
'open word
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
'loop through cell Stores wanted
For Each cel In Range("todoStore") ' This is a list of stores whic
I want to produce
Sheets("main").Range("e16").Value = cel.Value
strStoreDoing = Sheets("main").Range("e17").Value
Application.ScreenUpdating = False
'miss certain stores
If (cel.Value + 0) > 1000 Then GoTo donotdoStore
'open word template
Set wrdDoc = wrdApp.Documents.Open(ThisWorkbook.Path
"\wrdStore.doc")
Set rng = wrdApp.ActiveDocument.Range
'Loop through sheets and autofilter the data according to which stor
you producing
For Each sheet In Sheets(Array("Sheet1", "sheet2", "sheet3", _
"sheet4"))
sheet.Select
Range("a1").Select
Selection.AutoFilter Field:=4, Criteria1:=strstoreDoing
Next sheet
'unlink fields
rng.Fields.Unlink
'unlink header and footers
' doHeadFoot
' wrdApp.ActiveDocument.Shapes("Text Box 22").Select
wrdApp.Selection.Fields.Unlink
'save as Store name
wrdDoc.SaveAs (ThisWorkbook.Path & "\reports\" & LCase(strCrtDoing
& " apr 2005 to mar 2006.doc")
wrdDoc.Close
'wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
' turn the Autofilters to All
For Each sheet In Sheets(Array("Sheet1", "sheet2", "sheet3", _
"sheet4"))
sheet.Select
Range("a1").Select
Selection.AutoFilter Field:=4
Next sheet
Application.ScreenUpdating = True
Sheets("main").Activate
Range("c13").Value = cel.Value
Next cel
donotdoStore:
Set wrdApp = Nothing
End Sub
Sub doHeadFoot()
Dim oField As Field
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim x As Integer
Dim z
For Each oSection In ActiveDocument.Sections
x = x + 1
If x = 1 Then GoTo missfirst:
For Each oHeader In oSection.Headers
If oHeader.Exists Then
If oHeader.Index = 0 Then GoTo missheader:
For Each oField In oHeader.Range.Fields
oField.Unlink
Next oField
missheader:
End If
Next oHeader
For Each oFooter In oSection.Footers
If oFooter.Exists Then
If oFooter.Index = 0 Then GoTo missfooter:
For Each oField In oFooter.Range.Fields
If Left(oField.Code, 5) = " LINK" Then oField.Unlink
Next oField
missfooter:
End If
Next oFooter
missfirst:
Next oSection
End Sub
Any help much appreciated