Question

我正在处理一个宏，将书签表从一个word文档复制并粘贴到另一个word文档。只要我在输入框中输入的值与现有书签匹配，它就可以正常工作，但是如果我输入错误值，它只会从源文档中拉入顶部表格。我明白为什么会这样做（因为如果找不到书签，它会选择表1），但我无法弄清楚如何修复它。我尝试进行错误处理，但由于它没有触发错误，我添加的内容不起作用。有人可以告诉我如何编辑下面的代码来解决这个问题吗？另外，有没有办法为源文档和目标文档使用相对路径？它们将始终位于同一文件夹中，但每个不同的用户将在其自己的文件夹中拥有它们的副本，并且我不想每次都重写宏。任何其他改进或编辑将不胜感激，例如如何在这里不如此使用选择事件。或者如果文件已经打开，如何不重新打开文件。命令按钮（和代码）位于目标文档（Product.docm）

中

Private Sub CommandButton2_Click()

' Copy table from source document and add to table in target document

  Dim oTarDoc As Document, oSourceDoc As Document   
  Dim oTable As Table   
  Dim oNewRow As Row

    Set oSourceDoc = Documents.Open("H:\Test Documents\Tables.docx")   
    Set oTarDoc = Documents.Open("H:\Test Documents\Product.docm")

    Application.ScreenUpdating = False

    oTarDoc.Activate
    Set oTable = oTarDoc.Tables(2)
    Set oNewRow = oTable.Rows(oTable.Rows.Count - 3)

    oSourceDoc.Activate
    Selection.GoTo What:=wdGoToBookmark, Name:="A" & InputBox("119f, 979, 981a...", "Enter Number and Letter as Shown")
    With oSourceDoc.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.Tables(1).Select
    Selection.Copy

    oTarDoc.Activate
    oNewRow.Select
    Selection.Paste
       Application.ScreenUpdating = True    End Sub

Answer 1

你可以这样做：

Dim bm As Word.Bookmark
Dim bm_name As String
.
.
bm_name = "A" & InputBox("119f, 979, 981a...", "Enter Number and Letter as Shown")
' TODO: if user hits Cancel, bm_name = "", need to trap with If bm_name=""
On Error Resume Next
Set bm = oSourceDoc.Bookmarks(bm_name)
If Err.Number = 0 Then
    bm.Select
    Selection.Tables(1).Select
    Selection.Copy
    ' Paste-to-target code goes here

Else
    Err.Clear
    MsgBox "Didn't find " bm_name, vbOKOnly, "Not found"
End If

希望有所帮助

Answer 2

您没有像我建议的那样修改添加行的代码。这是您自己以前的代码导致错误。以下代码经过测试，可以按照您现在的描述进行操作。

Private Sub CommandButton2_Click()

    ' Copy table from source document and add to table in target document

    Dim TarDoc As Document, SourDoc As Document
    Dim Tbl As Table
    Dim NewRow As Row
    Dim Mark As String, MarkText As String

    Set SourDoc = Documents.Open("H:\Test Documents\Tables.docx")
    Set TarDoc = Documents.Open("H:\Test Documents\Product.docm")

    Application.ScreenUpdating = False

    Set Tbl = TarDoc.Tables(2)
    With Tbl
       Set NewRow = .Rows.Add(BeforeRow:=.Rows(.Rows.Count - 2))
    End With

    Do
        Mark = InputBox("119f, 979, 981a...", "Enter Number and Letter as Shown")
        If Len(Mark) Then              ' do nothing if user enters nothing
            Mark = "A" & Mark
            If SourDoc.Bookmarks.Exists(Mark) Then
                MarkText = SourDoc.Bookmarks(Mark).Range.Text
                NewRow.Cells(1).Range.Text = MarkText
                Mark = vbNullString    ' to enable existing the loop
            Else
                MsgBox "Bookmark """ & Mark & """ doesn't exist.", vbInformation, _
                       "Invalid entry"
            End If
        End If
    Loop While Len(Mark)               ' the user entered a wrong mark

    Application.ScreenUpdating = True
End Sub

Answer 3

请尝试此代码。我添加了一些评论，希望你会发现它们很有用。

Private Sub CommandButton2_Click()

    ' Copy table from source document and add to table in target document

    Dim TarDoc As Document, SourDoc As Document
    Dim Tbl As Table
    Dim NewRow As Row
    Dim Mark As String, MarkText As String

    Set SourDoc = Documents.Open("H:\Test Documents\Tables.docx")
    Set TarDoc = Documents.Open("H:\Test Documents\Product.docm")

    Application.ScreenUpdating = False

'    TarDoc.Activate                            ' no need to activate
    ' actually, since ScreenUpdating is off, Activate is without effect
    Set Tbl = TarDoc.Tables(2)
    Set NewRow = Tbl.Rows(Tbl.Rows.Count - 3)   ' this is an existing row
    ' this code inserts a row before the existing row(3)
    ' With Tbl
    '    .Rows.Add BeforeRow:=.Rows(3)
    ' End With
    ' use Tbl.Rows.Add to append a row at the end
'    SourDoc.Activate                           ' no need to activate

    Do
        Mark = InputBox("119f, 979, 981a...", "Enter Number and Letter as Shown")
        If Len(Mark) Then              ' do nothing if user enters nothing
            Mark = "A" & Mark
            If SourDoc.Bookmarks.Exists(Mark) Then
                MarkText = SourDoc.Bookmarks(Mark).Range.Text
                ' This seems to serve no purpose:
                '    With SourDoc.Bookmarks
                '        .DefaultSorting = wdSortByName
                '        .ShowHidden = False
                '    End With
                '    Selection.Tables(1).Select ' no need to select
                '    Selection.Copy             ' MarktText already got the text
                '    TarDoc.Activate            ' no need to activate
                '    NewRow.Select              ' no need to select
                '    Selection.Paste            ' no need to paste
                NewRow.Cells(1).Range.Text = MarkText
                Mark = vbNullString    ' to enable existing the loop
            Else
                MsgBox "Bookmark """ & Mark & """ doesn't exist.", vbInformation, _
                       "Invalid entry"
            End If
        End If
    Loop While Len(Mark)               ' the user entered a wrong mark

    Application.ScreenUpdating = True
End Sub

如果用户输入不存在的标记名称，则会收到错误消息和其他机会。要在不输入有效书签的情况下退出InputBox，请将其留空。

如果书签不存在，则在GoTo Bookmark上处理错误

3 个答案: