Question

我目前正在使用VBA开发一个项目，它不是我能够遵守的语言。

我正在尝试将所有数据都放在电子表格中，并使用找到相应标签的.Find函数将其粘贴到word模板中。

在搜索找到要查找的字符串之后，它才能将最终表放在文档的末尾。这是因为该表是动态的，因此总是具有不同的行数，因此它不能具有预定义的表。

 If Len(Trim(.Cells(1, lCol))) <> 0 Then
    sSearch = .Cells(1, lCol)
    sSearch = "<<" & Trim(sSearch) & ">>"
    sTemp = .Cells(lRow, lCol)

    With oDocRange.Find
        .ClearFormatting
        .Text = sSearch
        .Replacement.ClearFormatting

        ' check - how to figure if string type?
        ' // If the cell text is > 255 then we get an error.
        ' // Calculate how many 'Chunks' of 250 are required to accomodate the long string.
        ' // If more than 1 chunk of text then we replace the original template
        ' // parameter with the first chunk and then insert additional parameters {2}, {3} etc
         ' // into the template and replace those with the additional chunks
        chunks = Round(Len(sTemp) / 250, 0)
        sTemp = Replace(sTemp, vbNewLine, vbCr) 
        sTemp = Replace(sTemp, Chr(10), vbCr)                          

        If sSearch = "<<Checklist>>" Then
           rng2.Copy            
           .Execute

           Set wrdTable = oDoc.Tables.Add(Range:=oDocRange, NumRows:=1, numColumns:=4)
           'With wrdTable
               'Selection.PasteAndFormat
               '.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
           'End With


           '.Execute FindText:="<<Checklist>>", ReplaceWith:=Selection, Format:=True, Replace:=wdReplaceAll

        End If

        If Len(sTemp) Mod 250 > 0 Then chunks = chunks + 1
        If chunks = 1 Then
           .Replacement.Text = sTemp
           .Execute Replace:=wdReplaceAll, Forward:=True, _
                 Wrap:=wdFindContinue
        Else
            .Execute FindText:=sSearch, ReplaceWith:="{1}", Replace:=wdReplaceAll
            For i = 1 To chunks
               chunk = Mid(sTemp, ((i - 1) * 250) + 1, 250)
               If i < chunks Then chunk = chunk & "{" & (i + 1) & "}"
               .Execute FindText:="{" & i & "}", ReplaceWith:=chunk, Replace:=wdReplaceAll
            Next i
        End If 'If chunks is > 0
    End With ' the oDocRange.Find
End If 'If the column value isn't blank

sSearch 是程序通过word文档查找的单词。我希望它找到清单，并将其替换为我设置为 rng2 的表格。在If语句中，我有一堆失败的尝试，但它总是回到"Type Mismatch" Error。

非常感谢任何帮助，我很乐意提供更多信息。谢谢！

Answer 1

我认为错误是因为Excel.VBA脚本正在用于Word.VBA脚本，反之亦然。

下面的脚本是一个简单的Excel.VBA脚本，它打开一个特定的Word文档，然后搜索sSearch，然后从Excel复制一系列单元格。

我发现当我想操作该应用程序时，我需要引用每个应用程序。 Word的示例我需要使用Word.Selection和Excel Excel.ActiveSheet.Range("A1:F13:)

Sub SomeSubRoutine()

Dim WordProgram As Object
Dim WordFile As Object

WordFilePath = "Some File Path"

'Starting Word
Set WordProgram = CreateObject("Word.Application")
'Allowing it to be visible or not visible (For Developing its always good to have it visible
WordProgram.Application.Visible = True

'Opening the desired Word File
Set WordFile = WordProgram.Documents.Open(Filename:=WordFilePath)

'Here you can allocate your sSearch String
sSearch = "<<Checklist>>"

With Word.Selection.Find

    .ClearFormatting
    .Text = "<<Checklist>>" 'sSearch
   ' .Execute

    Do While .Execute
        If .Found = True Then

            Set EventData = Excel.ActiveSheet.Range("A1:F13")

            'Copying Event Log from the opened Excel File
            EventData.Copy

            With Word.Selection

                'Pasting Event Log into Word Doc
                .PasteAndFormat Type:=wdFormatOriginalFormatting
                'Selecting the Table
                .Tables(1).Select
                'Horizontal Centering Text in the Table Rows
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                'Center Table to Page Center
                .Tables(1).Rows.Alignment = wdAlignRowCenter
                'Vertical Centering of Text in the Table Row
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter
                'Moving out of the Table to continue search
                .MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove

            End With ' Ending "Word.Selection"

        Else

        'If nothing found then some other script can go here

        End If 'Ending "If .Found"

    Loop

End With ' Ending "Word.Selection.Find"

    'Quiting the Word Application
    WordProgram.Quit

    'clean up Objects for next use
    Set WordProgram = Nothing
    Set WordFile = Nothing

End Sub

只需检查您对所有搜索的每个应用程序的引用。

如何使用.Find函数将动态表从Excel粘贴到Word

1 个答案: