0

Excel セルがクリックされたときに Excel から Word にデータをコピーするコード VBA を作成しました。プロセスは次のとおりです。

1. Opens an already created word document, duplicates the word document, and then closes the original document; leaving open the copy (duplicate) for further modification.

2. The code then finds and replaces some placeholder values within the word document with values from the Excel document.

3. The code then deletes 2 different tables (1 at a time), row by row, and replaces each table (1 at a time) with a table copied from Excel.

4. The code then displays a message to the user that all has been completed and exits.

すべてのコードは私の PC では完全に機能しますが、同僚の MAC では失敗し、「エラー: 4605 - コマンドが利用できません」と表示され、wrdApp.Selection.PasteExcelTable False, False, Trueコード行で失敗します。

コードは次のとおりです。

Sub Copy2Word()

    Dim wrdApp As Object
    Dim tempDoc As Word.Document
    Dim mrgDoc As Word.Document
    Dim NumPay As Integer
    Dim cll As Excel.Range

    'GET NUMBER OF PAYMENTS SELECTED FOR USE BELOW
    NumPay = Notated.Cells(Data.Range("DV2").Value, Data.Range("DV3").Value).Value

    'GET LOCATION OF WORD FILE FROM USER
    FName = Application.GetOpenFilename
    If FName = False Then
        usrErr = 1
        GoTo ErrHnd
    End If

    'RECORD THE WORD FILE LOCATION ON HIDDEN SHEET FOR USE BY OTHER MACROS
    MergeData.Range("B2").Value = FName

    'CREATE WORD OBJECT
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wrdApp Is Nothing Then
        Set wrdApp = CreateObject("Word.Application")
    End If

    'DISPLAY WORD APPLICATION
    On Error Resume Next
    wrdApp.Visible = True
    wrdApp.Activate
    On Error GoTo 0

    'OPEN THE (TEMPLATE) FILE
    wrdApp.Documents.Open Filename:=FName

    'SET A VARIABLE TO REFERENCE ACTIVE DOCUMENT (TEMPLATE)
    Set tempDoc = wrdApp.ActiveDocument

    'DUPLICATE THE DOCUMENT
    wrdApp.Documents.Add wrdApp.ActiveDocument.FullName

    'SET A VARIABLE TO REFERENCE THE NEW VERSION OF DOCUMENT
    Set mrgDoc = wrdApp.ActiveDocument

    'CLOSE THE ORIGINAL (TEMPLATE) VERSION OF DOCUMENT
    tempDoc.Close SaveChanges:=False

    'ACTIVATE THE NEW DOCUMENT
    mrgDoc.Activate

    'REPLACE PLACEHOLDER TEXT ITEMS WITH ACTUAL
    For Each cll In MergeData.Range(MergeData.Cells(1, 3).Address & ":" & MergeData.Cells(1, MergeData.Range("A1").End(xlToRight).Column).Address)
        If cll.Offset(1, 0).Value = "" Then
            repTx = cll.Value
       Else
            repTx = cll.Offset(1, 0).Value
        End If
        With mrgDoc.Content.Find
            .Text = cll.Value
            .Replacement.Text = repTx
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
        End With
    Next cll

    'REPLACE TABLE 2 ON WORD DOC
    mrgDoc.Tables(2).Select
    For ii = 30 To 2 Step -1
        mrgDoc.Tables(2).Rows(ii).Delete
    Next ii
    wrdApp.Selection.TypeParagraph

    'COPY AND PASTE TABLE 1 FROM EXCEL TO WORD
    Application.CutCopyMode = False
    EO_DOC.Range("EO_TBL_INSCOPE_1").Copy
    wrdApp.Selection.PasteExcelTable False, False, True 

    ''''REMAINDER OF CODE AND COMPLETION CONFIRMATION TO USER''''

End Sub

DoEvents を追加するなど、状況が改善されるかどうかを確認するなど、さまざまなことを試しましたが、まだ解決策は見つかりませんでした。

そこに MAC 教祖のための VBA はありますか? 誰?

前もって感謝します。

4

1 に答える 1