Question

我正在尝试在Excel中创建一个宏，它将带有一些书签的示例Word文件放在书签上。它适用于一个书签，但对于第二个，第三个等，它只是删除其他条目。

E.g。运行我的代码后，我只写了“Info4”。我看到在宏运行时正在编写和删除Info1，Info2和Info3。

有什么想法吗？代码如下：

Option Explicit

Public Sub Main()

    If [set_in_production] Then On Error GoTo Main_Error

    Dim word_obj            As Object
    Dim word_doc            As Object
    Dim obj                 As Object
    Dim rng_range           As Variant
    Dim obj_table           As Object
    Dim origDoc$
    Dim l_row&: l_row = 2

    On Error Resume Next

    Set word_obj = GetObject(, "Word.application.14")
    If Err.Number = 429 Then
        Set word_obj = CreateObject("Word.application.14")
        Err.Number = 0
    End If

    If [set_in_production] Then On Error GoTo Main_Error Else On Error GoTo 0
    origDoc$ = ActiveWorkbook.Path & "\" & CStr(Replace(Time, ":", "_")) & "_" & generate_name & ".docx"
    word_obj.Visible = True
    word_obj.DisplayAlerts = False
    Set word_doc = word_obj.Documents.Open(ActiveWorkbook.Path & "\SAMPLE_2.docx")
    word_obj.activedocument.SaveAs Filename:=origDoc

    'after the saveas -> write

    Dim obj_BMRange     As Object

    Set obj_BMRange = word_obj.activedocument.Bookmarks("Info1").Range
    obj_BMRange.Text = "Info1" & vbCrLf
    Set obj_BMRange = Nothing

    Set obj_BMRange = word_obj.activedocument.Bookmarks("Info2").Range
    obj_BMRange.Text = "Info2" & vbCrLf
    Set obj_BMRange = Nothing

    Set obj_BMRange = word_obj.activedocument.Bookmarks("Info3").Range
    obj_BMRange.Text = "Info3" & vbCrLf
    Set obj_BMRange = Nothing

    Set obj_BMRange = word_obj.activedocument.Bookmarks("Info4").Range
    obj_BMRange.Text = "Info4" & vbCrLf
    Set obj_BMRange = Nothing
    word_obj.DisplayAlerts = False

    Set word_obj = Nothing
    Set word_doc = Nothing
    Set rng_range = Nothing
    Set obj = Nothing
    Set obj_table = Nothing

    On Error GoTo 0
    Exit Sub

Main_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Main of Sub mod_main"

End Sub

我已经尝试重写书签，一旦被删除，但成功并没有什么不同。因此，等待想法！：d

Answer 1

以下方法适合我。（请注意，我必须删除特定于您的工作簿和文件的代码行，因为我无法访问其中的任何内容。但它不会（不应该）更改与您出现的问题相关的任何内容。）< / p>

您发布的代码中没有任何意义的事情是声明word_doc变量，然后不使用它，而是依赖ActiveDocument。我酌情替换了word_doc。

我还插入了On Error GoTo 0来重新启动正常的错误处理。当您使用On Error Resume Next时，系统会停用正常的错误处理功能，您需要使用GetObject进行处理。但是一旦访问Word应用程序，就需要重新打开它。在例程结束时使用它是没有意义的。

正如其他人所提到的，Word会在内容写入时删除书签如果书签已经有内容（您看到[方括号]）。为了解决这个问题，需要在分配给Range的内容周围重新创建书签。由于这涉及几个步骤，我编写了一个单独的函数来写入书签 - WriteToBookmarkRetainBookmark。

当我从Excel测试时，信息会写入每个书签，最后会有书签。

Option Explicit

Public Sub Main()

    Dim word_obj            As Object
    Dim word_doc            As Object
    Dim obj                 As Object
    Dim rng_range           As Variant
    Dim obj_table           As Object
    Dim origDoc$
    Dim l_row&: l_row = 2

    On Error Resume Next

    Set word_obj = GetObject(, "Word.application.14")
    If Err.Number = 429 Then
        Set word_obj = CreateObject("Word.application.14")
        Err.Number = 0
    End If
    On Error GoTo 0

    word_obj.Visible = True
    word_obj.DisplayAlerts = False
    Set word_doc = word_obj.ActiveDocument
'    word_obj.ActiveDocument.SaveAs Filename:=origDoc

    'after the saveas -> write

    Dim obj_BMRange     As Object

    Set obj_BMRange = word_doc.Bookmarks("Info1").Range
    WriteToBookmarkRetainBookmark obj_BMRange, "Info1" & vbCrLf
    Set obj_BMRange = Nothing

    Set obj_BMRange = word_doc.Bookmarks("Info2").Range
    WriteToBookmarkRetainBookmark obj_BMRange, "Info2" & vbCrLf
    Set obj_BMRange = Nothing

    Set obj_BMRange = word_doc.Bookmarks("Info3").Range
    WriteToBookmarkRetainBookmark obj_BMRange, "Info3" & vbCrLf
    Set obj_BMRange = Nothing

    word_obj.DisplayAlerts = False

    Set word_obj = Nothing
    Set word_doc = Nothing
    Set rng_range = Nothing
    Set obj = Nothing
    Set obj_table = Nothing

    Exit Sub

Main_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Main of Sub mod_main"

End Sub

Function WriteToBookmarkRetainBookmark(rng As Object, content As String)
    Dim sBkmName As String

    sBkmName = rng.Bookmarks(1).Name
    rng.Text = content
    rng.Document.Bookmarks.Add sBkmName, rng
End Function

Answer 2

我找到了一些解决方法 - 在Word中使用替换 - 代码有点＆＃34;丑陋＆＃34;，不干，但它有效：

With word_obj.ActiveDocument.Content.Find
  .Text = "Info001"
  .Replacement.Text = "VITYA1"
  .Execute Replace:=wdReplaceAll

  .Text = "Info002"
  .Replacement.Text = "VITYA2"
  .Execute Replace:=wdReplaceAll

  .Text = "Info003"
  .Replacement.Text = "VITYA3"
  .Execute Replace:=wdReplaceAll

  .Text = "Info004"
  .Replacement.Text = "VITYA4"
  .Execute Replace:=wdReplaceAll

End With

With word_obj.ActiveDocument.Shapes(1).TextFrame.TextRange.Find
    .Text = "Info005"
    .Replacement.Text = "VITYATA5"
    .Execute Replace:=wdReplaceAll

    .Text = "Info006"
    .Replacement.Text = "VITYATA6"
    .Execute Replace:=wdReplaceAll

    .Text = "Info007"
    .Replacement.Text = "VITYATA7"
    .Execute Replace:=wdReplaceAll

    .Text = "Info008"
    .Replacement.Text = "VITYATA8"
    .Execute Replace:=wdReplaceAll

End With

但是，如果有人知道如何解决原始问题，我希望看到它：）

VBA - Word - 当我尝试在其上书写文字时书签消失

2 个答案: