title: Using VBA Macro to create a word doc then running macro in word doc.... crashes excel on end sub
body: <p>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:</p>
  
  <p>WordObj.Run ("normal!Picture")  'this calls a macro in Word which works and debugs perfectly</p>
  
  <p>end sub</p>
  
  <p>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!</p>
  
  <p>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).</p>
  
  <p>I suppress messages but here is a related message that I get if I unsuppress errors:</p>
  
  <p>"Microsoft Excel is waiting for another application to complete OLE action", but I believe this is happening when it's trying to open WORD.</p>
  
  <p>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.</p>
  
  <p>I will be checking my email regularly and working diligently on this.  If I happen to find a solution I will post it immediately.</p>
  
  <p>Excel Macro: </p>
  
  <pre><code>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  " &amp; company &amp; " 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
  </code></pre>
  
  <p>WORD MACRO:</p>
  
  <pre><code>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 &gt; 0 Then
  
  Set pic1 = Selection.InlineShapes.AddPicture(FileName:= _
      myfolder &amp; company &amp; "\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 &gt; 0 Then
  
  Set pic2 = Selection.InlineShapes.AddPicture(FileName:= _
    myfolder &amp; company &amp; "\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 &gt; 0 Then
  
  Set pic3 = Selection.InlineShapes.AddPicture(FileName:= _
      myfolder &amp; company &amp; "\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 &gt; 0 Then
  
  Set pic4 = Selection.InlineShapes.AddPicture(FileName:= _
      myfolder &amp; company &amp; "\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 &gt; 0 Then
  Set pic5 = Selection.InlineShapes.AddPicture(FileName:= _
      myfolder &amp; company &amp; "\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") &gt; 0 Then
  verbiage = oWorkSheet.Range("H27").Value
  Set spec1 = Selection.InlineShapes.AddPicture(FileName:="c:\sales\spec\" &amp; verbiage &amp;  ".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") &gt; 0 Then
  verbiage2 = oWorkSheet.Range("H28").Value
  Set spec2 = Selection.InlineShapes.AddPicture(FileName:= _
      "C:\sales\spec\" &amp; verbiage2 &amp; ".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") &gt; 0 Then
  verbiage3 = oWorkSheet.Range("H29").Value
  Set spec3 = Selection.InlineShapes.AddPicture(FileName:= _
      "C:\sales\spec\" &amp; verbiage3 &amp; ".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\" &amp; company &amp; "\" &amp; company &amp; ".doc")
  
  MsgBox "A new company proposal for " &amp; company &amp; " has been created"
  
  End Sub
  </code></pre>