使用VBA宏创建一个word doc然后在word doc中运行宏....崩溃excel on end sub

时间：2014-06-11 19:54:04

标签： excel vba excel-vba ms-word

我根据使用宏输入Excel电子表格的数据创建销售提案，然后我调用宏来导入一些＆＃39; stock＆＃39;图片取决于输入电子表格的数据。第二个宏保存在normal.dot文档中，并通过以下代码调用：

WordObj.Run（＆＃34;正常！图片＆＃34;）＆＃39;这会调用Word中的一个宏，它可以完美地运行和调试

结束子

当宏完成并给出最后一条消息，指出文档已成功完成并转到“结束”字段。在Word宏上，我收到一条错误消息，指出Excel已崩溃，需要重新启动！

这些宏是在2002年创建的，并且在每个版本的Office中都有效，但我们开始升级到Office 2010，现在当我运行此宏时，它崩溃了Excel（仅在Office 2010客户端上）。

我禁止消息但是如果我解除了错误，这里是一个相关的消息：

＆＃34; Microsoft Excel正在等待另一个应用程序完成OLE操作＆＃34;但我相信当它尝试打开W​​ORD时会发生这种情况。

在我有限的VBA体验中，我认为需要将重点发送回Excel中的宏，以便它可以正确地结束它的子程序。我认为Word宏正在正确完成，但没有让最后一个结束子'＃在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

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

1 个答案:

答案 0 :(得分：0)

如果它在End Sub上崩溃，它可能与对象的破坏有关。确保在代码退出之前手动销毁对象。这将让您了解哪个对象正在崩溃代码。

在应用程序之间进行编码时，我不使用两个不同的MACROS。可以告诉Word（或excel）互相运行。

将所有代码放在1个应用程序中的1个宏中。例如，excel做东西然后打开单词。所以有excel告诉你该怎么做。

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

通过引用正确的库（2010年的Microsoft Word 14.0对象库和2013年的Microsoft Word 15.0对象库），您可以告诉excel在word文档中做什么，如我的示例所示。

通常，这就像复制和粘贴代码一样简单，然后将这个部分包含在with语句中：

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

我在尝试从不同的应用程序调用宏时发现的另一个问题是，很难知道宏是否存在于另一端。也许用户安装错误（我的宏分发给~300人）

相关问题
最新问题