使用VBA宏创建Word文档，然后在Word文档中运行宏...。

我根据使用宏输入到Excel电子表格中的数据创建销售建议，然后调用宏以根据输入到电子表格中的数据导入一些“库存”图片。第二个宏保存在normal.dot文档中，并通过以下代码调用：

WordObj.Run（“ normal！Picture”）'，这将调用Word中的宏，该宏可以完美地工作和调试

结束子

当宏完成并给出最后一条消息，表明文档已成功完成并转到Word宏上的“ end sub”时，我收到一条错误消息，指出Excel已崩溃，需要重新启动！

这些宏创建于2002年，并且可以在所有版本的Office中使用，但是我们开始升级到Office 2010，现在当我运行此宏时，它会使Excel崩溃（仅在Office 2010客户端上）。

我禁止显示消息，但是如果我取消抑制错误，则会收到以下相关消息：

“ Microsoft Excel正在等待另一个应用程序完成OLE操作”，但是我认为在尝试打开W​​ORD时会发生这种情况。

根据我有限的VBA经验，我认为需要将焦点发送回Excel中的宏，以便可以正确结束子过程。我认为Word宏可以正确完成，但不能让最后一个“ end sub”在Excel宏中运行。但是我不知道如何将焦点放回到Excel宏中。

我将定期检查我的电子邮件，并为此进行认真的工作。如果碰巧找到解决方案，我会立即发布。

Excel宏：

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

字宏：

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