VBA WordTextmarke aus Excel heraus befüllfen

  • Word

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    VBA WordTextmarke aus Excel heraus befüllfen

    Visual Basic-Quellcode

    1. Sub lieferscheinerzeugen()
    2. '
    3. ' lieferscheinerzeugen Makro
    4. '
    5. ' Tastenkombination: Strg+e
    6. '
    7. Dim LFExcel As String
    8. Dim wbQuelle As Workbook
    9. Dim wbZiel As Workbook
    10. Dim ar As Variant
    11. Dim rtn As Variant
    12. Dim AppWD As Object
    13. Dim objDoc As Object
    14. Dim objDocProdTP As Object
    15. Dim i As Integer
    16. Dim counter As Integer
    17. Dim firstCheck As Boolean
    19. Dim LFNr As String 'LieferscheinNummer
    22. Set wbZiel = ThisWorkbook
    23. Dim workPath As String
    24. workPath = wbZiel.Path
    25. 'MsgBox (workPath)
    27. 'Set WDLF = AppWDLF.documents.Open(workPath & "\vorlagen\LFTemplate.docx")
    28. Set AppWD = CreateObject("Word.Application") 'Word als Object starten
    29. AppWD.Visible = True
    30. 'Set objDocProdTP = AppWD.documents.Open(workPath & "\vorlagen\LFPostTemplate.docx")
    31. Set objDoc = AppWD.documents.Open(workPath & "\vorlagen\LFTemplate2.docx")
    34. With Application.FileDialog(msoFileDialogOpen)
    35. .AllowMultiSelect = False
    36. .Show
    37. LFExcel = .SelectedItems(1)
    38. End With
    40. 'MsgBox (LFExcel)
    41. Set wbQuelle = Workbooks.Open(LFExcel)
    43. 'Hier wir die letzte Zeile der Spalte A ermittelt
    44. letztezeile = wbQuelle.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
    46. ar = wbQuelle.Sheets("Tabelle1").Range(Cells(2, 6), Cells(letztezeile, 6))
    47. rtn = removeDuplicates(ar)
    48. 'MsgBox (CStr(UBound(rtn) + 1) & " Paletten gefunden")
    50. For counter = 0 To UBound(rtn)
    51. firstCheck = True
    52. LFNr = rtn(counter)
    53. 'MsgBox (objDoc.Bookmarks.Count)
    54. 'objDoc.Goto what:=-1, Name:="lblSBody"
    55. 'MsgBox (objDocProdTP.Bookmarks.Count)
    56. For i = 2 To letztezeile
    59. If wbQuelle.Sheets("Tabelle1").Cells(i, 7) <> "" Then
    60. If firstCheck Then
    61. firstCheck = False
    62. lieferNr = wbQuelle.Sheets("Tabelle1").Cells(i, 6)
    63. lieferDate = wbQuelle.Sheets("Tabelle1").Cells(i, 10)
    64. lieferFirma = wbQuelle.Sheets("Tabelle1").Cells(i, 64)
    65. lieferStr = wbQuelle.Sheets("Tabelle1").Cells(i, 65)
    66. lieferPlz = wbQuelle.Sheets("Tabelle1").Cells(i, 66)
    67. lieferOrt = wbQuelle.Sheets("Tabelle1").Cells(i, 67)
    68. lieferPlNr = wbQuelle.Sheets("Tabelle1").Cells(i, 11)
    69. End If
    71. Else
    72. lieferVPE = wbQuelle.Sheets("Tabelle1").Cells(i, 38) & " " & wbQuelle.Sheets("Tabelle1").Cells(i, 39)
    73. lieferBW = wbQuelle.Sheets("Tabelle1").Cells(i, 41)
    74. lieferNW = wbQuelle.Sheets("Tabelle1").Cells(i, 37)
    75. End If
    76. objDoc.Activate
    77. objDoc.Bookmarks("lblSPalNr").Select
    78. objDoc.Selection.TypeText ("123456")
    80. objDoc.Selection.Bookmarks("lblSPalNr").Range.Text ="123456"
    81. Next
    82. objDoc.SaveAs Filename:=workPath & "\fertig\" & LFNr & ".doc"
    83. Next
    87. End Sub


    Ich versuche nun das bookmark lblSPalNr in LFTemplate.docx zu befüllen
    Beide Methoden , also objDoc.Selection.TypeText ("123456") und objDoc.Selection.Bookmarks("lblSPalNr").Range.Text = "123456" werfen Fehler:

    438 - Objekt unterstützt diese Eigenschaft oder Methode nicht.

    Eigentlich sollte das glaube ich ziemlich simple sein... beim ersten Block funktioniert auch das selektieren.... nur Schreiben... schreiben tut er halt nix.
    Bitte Bitte rettet meinen Sonntag ?(

    PS Textmarken sind natürlich im jeweiligen Dokument vorhanden

Facebook
Telefonspende