As always any help you can provide is much appreciated,
Milan
Code is;
Expand|Select|Wrap|Line Numbers
- Sub Report()
- Dim x As Integer
- For x = 0 To Sheets("Representation").combobox1.ListCount - 1
- Dim DTAddress As String
- Dim wdApp As Object
- Dim wd As Object
- Dim sFil As String
- DTAddress = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & Application.PathSeparator
- On Error Resume Next
- Set wdApp = GetObject("Word.Application")
- If Err.Number <> 0 Then
- Set wdApp = CreateObject("Word.Application")
- End If
- On Error GoTo 0
- Set wd = wdApp.Documents.Add
- wdApp.Visible = False
- Range("Milsys").CopyPicture xlScreen, xlPicture
- wd.Range.PasteSpecial Link
- wdApp.ActiveDocument.SaveAs Filename:=DTAddress & Workbooks("M2").Sheets("Representation").combobox1.List(x) & ".doc"
- wdApp.Quit
- Next x
- End Sub