Using VBA Macro to create a word doc then running macro in word doc… crashes excel on end sub

Question

I create a sales proposal from data entered into an Excel spreadsheet using a macro, then I call a macro to import some 'stock' pictures depending on the data that was entered into the spreadsheet. This second macro is saved in the normal.dot document and called by the following code:

WordObj.Run ("normal!Picture") 'this calls a macro in Word which works and debugs perfectly

end sub

When the macro finishes and gives the final message stating that the document successfully finished and goes to the 'end sub' on the Word macro I get an error message stating that Excel has crashed and needs to be restarted!

These macros were created in 2002 and have worked throughout every version of Office, but we are starting to upgrade to Office 2010 and now when I run this macro it crashes Excel (only on Office 2010 clients).

I suppress messages but here is a related message that I get if I unsuppress errors:

"Microsoft Excel is waiting for another application to complete OLE action", but I believe this is happening when it's trying to open WORD.

In my limited VBA experience, I think that the focus needs to be sent back to the macro in Excel so it can end it's sub properly. I am thinking that the Word macro is completing properly but not letting the last 'end sub' run in the Excel macro. However I can't figure out how to put the focus back in the Excel macro.

I will be checking my email regularly and working diligently on this. If I happen to find a solution I will post it immediately.

Excel Macro:

Sub Proposal1()

Dim appwd As Object
Dim bookmark1 As String
Dim test As String
Dim ans As String
Dim company As String
Dim goOn As Integer

company = Range("survey!D1")

goOn = MsgBox(prompt:="Do you want to create a proposal for  " & company & " at this         time?", _
    Buttons:=vbYesNo)
If goOn = vbNo Then Exit Sub

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="c:\sales\salescalc.xls"
Application.DisplayAlerts = True

Static WordObj As Word.Application
Set WordObj = Nothing
Set WordObj = CreateObject("Word.Application")

WordObj.Visible = True

With WordObj
    .Documents.Add Template:=("C:\sales\sales\proposal1.dot")
    On Error Resume Next

    'Bunch of logic here that reads cells and inputs text to word doc'
    'about 150 lines of code all runs normal'

End With

End Sub

WORD MACRO:

Sub picture()

Dim oExcel As Object
Dim oWorkbook As Object
Dim oWorkSheet As Object
Dim verbiage As String
Dim doc As Word.Document
Dim bkmname As String
Dim bkname2 As String
Dim bkname3 As String
Dim verbiage2 As String
Dim verbiage3 As String
Dim spec1 As InlineShape
Dim spec2 As InlineShape
Dim spec3 As InlineShape
Dim pic1 As InlineShape
Dim pic2 As InlineShape
Dim pic3 As InlineShape
Dim pic4 As InlineShape
Dim pic5 As InlineShape
Dim vpic1 As String
Dim company As String
Dim myfolder As String
Dim foldername As String

Set fs = CreateObject("Scripting.FileSystemObject")
Set oExcel = GetObject(, "Excel.Application")

oExcel.Visible = True

Set oWorkbook = oExcel.Workbooks.Open("c:\sales\salescalc.xls")
Set oWorkSheet = oWorkbook.Sheets("survey") 

bkmname = "SO1"
bkmname2 = "SO2"
bkmname3 = "SO3"
vpic1 = "pic1"
company = oWorkSheet.Range("d1").Value
myfolder = "C:\proposals\"

Set doc = ActiveDocument
If oWorkSheet.Range("b15").Value > 0 Then

Set pic1 = Selection.InlineShapes.AddPicture(FileName:= _
    myfolder & company & "\pics\pic1.jpg" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks("pic1").Range)

With pic1
    .Width = InchesToPoints(2.46)
    .Height = InchesToPoints(1.69)
End With
End If

If oWorkSheet.Range("b16").Value > 0 Then

Set pic2 = Selection.InlineShapes.AddPicture(FileName:= _
  myfolder & company & "\pics\pic2.jpg" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks("pic2").Range)

With pic2
    .Width = InchesToPoints(2.46)
    .Height = InchesToPoints(1.69)
End With
End If

If oWorkSheet.Range("b17").Value > 0 Then

Set pic3 = Selection.InlineShapes.AddPicture(FileName:= _
    myfolder & company & "\pics\pic3.jpg" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks("pic3").Range)

With pic3
    .Width = InchesToPoints(2.46)
    .Height = InchesToPoints(1.69)
End With
End If

If oWorkSheet.Range("b18").Value > 0 Then

Set pic4 = Selection.InlineShapes.AddPicture(FileName:= _
    myfolder & company & "\pics\pic4.jpg" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks("pic4").Range)

With pic4
    .Width = InchesToPoints(2.46)
    .Height = InchesToPoints(1.69)
End With
End If

If oWorkSheet.Range("b19").Value > 0 Then
Set pic5 = Selection.InlineShapes.AddPicture(FileName:= _
    myfolder & company & "\pics\pic5.jpg" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks("pic5").Range)

With pic5
    .Width = InchesToPoints(2.46)
    .Height = InchesToPoints(1.69)
End With
End If

Set doc = ActiveDocument
If oWorkSheet.Range("b7") > 0 Then
verbiage = oWorkSheet.Range("H27").Value
Set spec1 = Selection.InlineShapes.AddPicture(FileName:="c:\sales\spec\" & verbiage &  ".gif" _
, linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks(bkmname).Range)

With spec1
    .Width = InchesToPoints(4.17)
    .Height = InchesToPoints(2.83)
End With
End If

If oWorkSheet.Range("b8") > 0 Then
verbiage2 = oWorkSheet.Range("H28").Value
Set spec2 = Selection.InlineShapes.AddPicture(FileName:= _
    "C:\sales\spec\" & verbiage2 & ".gif" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks(bkmname2).Range)

With spec2
    .Width = InchesToPoints(4.17)
    .Height = InchesToPoints(2.83)
End With
End If

If oWorkSheet.Range("b9") > 0 Then
verbiage3 = oWorkSheet.Range("H29").Value
Set spec3 = Selection.InlineShapes.AddPicture(FileName:= _
    "C:\sales\spec\" & verbiage3 & ".gif" _
    , linktofile:=False, savewithdocument:=True, Range:=doc.Bookmarks(bkmname3).Range)
With spec3
    .Width = InchesToPoints(4.17)
    .Height = InchesToPoints(2.83)
End With
End If

ActiveDocument.SaveAs FileName:=("c:\proposals\" & company & "\" & company & ".doc")

MsgBox "A new company proposal for " & company & " has been created"

End Sub

Answer 1

If it's crashing on End Sub it's likely related to the destruction of objects. Make sure you manually destroy your objects prior to the code exiting. This will give you an idea of exactly which object is crashing the code.

I do not use two different MACROS when coding between applications. It is possible to tell Word (or excel) to run each other.

Place all of the code within only 1 macro in 1 application. For instance, excel does stuff and then opens word. So have excel tell word what to do directly.

Sub test()
Dim wdApp As New Word.Application
wdApp.Visible = True
wdApp.Documents.Add
wdApp.ActiveDocument.Paragraphs(1).Range.Text = "Hello World"
End Sub

By referencing the correct library (Microsoft Word 14.0 object library for 2010 and Microsoft Word 15.0 object library for 2013) you can can tell excel what to do within the word document as my example shows.

Generally, this is as easy as copy and pasting the code and then enclosing the part for word in a with statement:

with wdAPP
    'All your word specific code here (might need to add a '.' before each command
end with

Another issue I found with trying to call macros from a different application is that it is hard to know if the macro exists on the other side. Maybe a user installed them incorrectly (my macros are distributed to ~300 people)