Makro auf mehrere Zeilen anwenden

[Liisty]

Hallo an alle,

ich möchte mir meine Arbeit in der Firma gerne erleichtern, indem ich aus meiner Excel-Tabelle direkt Word-Dokumente (.dot) öffnen lasse. In dieser dot-Datei sollen dann schon alle relevanten Daten der Excel-Tabelle eingetragen sein. Ein Serienbrief bietet sich leider nicht an, da die Excel-Tabelle aus mehreren Tabellenblättern besteht, ich immer nur einzelne Kunden anschreibe und ich oft die dot-Datei ändern muss. (Bisher habe ich den entsprechenden Brief geöffnet und alle Daten händisch eingetragen).

Nach stundenlangem Suchen im Internet konnte ich bereits ein Makro finden, was meine Erwartungen voll erfüllt: (abgespeckte Version)

Sub doc_aus_Template()
Dim m_objWDApp, m_objWDDoc As Object
Dim m_strTemplateFile, strBMName, strBMText As String

m_strTemplateFile = Application.GetOpenFilename("Template (*.dot) , *.DOT")
Set m_objWDApp = CreateObject("Word.Application")
m_objWDApp.Visible = True
Set m_objWDDoc = m_objWDApp.Documents.Add( _
        Template:=m_strTemplateFile, NewTemplate:=False)

strBMName = "Vorname"
strBMText = Range("C2")
  Call AddTextToBookmarks(m_objWDDoc, strBMName, _
           strBMText)
            
strBMName = "Nachname"
strBMText = Range("B2")
  Call AddTextToBookmarks(m_objWDDoc, strBMName, _
           strBMText)
            
           Set m_objWDApp = Nothing
           Set m_objWDDoc = Nothing
End Sub


Sub AddTextToBookmarks(ByRef m_objWDDoc As Object, ByVal strBMName As String, _
            ByVal strBMText As String)
    
    'Range-Objekt, hier Textmarken-Bereiche
    Dim objBMRange As Object
    
    With m_objWDDoc
        'Wenn die Textmarke existiert...
        If .Bookmarks.Exists(strBMName) Then
            'Verweis auf den Textmarken-Bereich setzen
            Set objBMRange = .Bookmarks(strBMName).Range
            'Text zuweisen
            objBMRange.Text = strBMText
            'Textmarke neu definieren
            .Bookmarks.Add Name:=strBMName, Range:=objBMRange
            'Verweis freigeben
            Set objBMRange = Nothing
        End If
    End With
End Sub


Mein Problem nun ist, dass sich das Makro nur auf bestimmte Zellen bezieht (C2 und B2 im Beispiel). Ungerne möchte ich für jede Zeile das Makro erneut schreiben. 

Es wäre super nett, wenn mir jemand helfen könnte, dass das Makro auf allen Zeilen Anwendung findet (z.B. ich markiere eine Zeile und die dot-Datei wird mit den Inhalten der Zeile geöffnet). Bitte beachtet aber, dass dies mein erster Marko-Versuch ist und ich so schon kaum etwas davon verstehe.

Vielen Dank im Voraus!

LG

Liisty

[Kuwer]

Hallo Liisty,

teste mal damit (rot markiertes ist neu oder geändert):

Sub doc_aus_Template()

Dim m_objWDApp, m_objWDDoc As Object

Dim m_strTemplateFile, strBMName, strBMText As String

Dim rngZeile As Range



Set rngZeile = ActiveCell.EntireRow



m_strTemplateFile = Application.GetOpenFilename("Template (*.dot) , *.DOT")

Set m_objWDApp = CreateObject("Word.Application")

m_objWDApp.Visible = True

Set m_objWDDoc = m_objWDApp.Documents.Add( _

        Template:=m_strTemplateFile, NewTemplate:=False)



strBMName = "Vorname"

strBMText = rngZeile.Cells(3).Value

  Call AddTextToBookmarks(m_objWDDoc, strBMName, _

           strBMText)

            

strBMName = "Nachname"

strBMText = rngZeile.Cells(2).Value

  Call AddTextToBookmarks(m_objWDDoc, strBMName, _

           strBMText)

            

           Set m_objWDApp = Nothing

           Set m_objWDDoc = Nothing

End Sub

Gruß Uwe

[Liisty]

Hallo Uwe,

es funktioniert einwandfrei! Ich danke dir so sehr!

LG
Liisty