Office-Fragen.de

Hallo,

ich habe vor einiger Zeit ein VBA Makro geschrieben, dass alle Zellen die mit einer Checkbox versehen waren kopiert haben und in eine Worddatei kopiert haben. Nach der Umstellung auf Excel 2016 funktioniert dieses Makro leider nicht mehr und ich bin ein wenig überfordert wieso.
Die Tabelle ist wie folgt aufgebaut:
In Spalte A sind die Checkboxen und in Spalte B und C der entsprechende Text, der dann bei Aktivierung in das Worddokument kopiert werden soll.

Hier mein Code:

Code:
Sub Makro12()

    Range("A4:A50").AutoFilter Field:=1, Criteria1:=True

    Range("B4:C50").Select

    Cells.SpecialCells(xlCellTypeVisible).Select

    Selection.Copy

    Dim objWord As Object

    Set objWord = CreateObject("Word.Application")

    objWord.documents.Open "T:\SCHWLA\Faxblätter\Briefkopflandesamt.docm"

    objWord.Visible = True

    objWord.ActiveDocument.Bookmarks("Data").Select

    objWord.Selection.PasteSpecial

    Dim c_Path As String

    Dim c_Name As String

    Dim strNewName As String, strTemp As String

    Dim bFound As Boolean, iCount As Integer, iMax As Integer

    Dim strName As String

    c_Path = objWord.ActiveDocument.Path & "\"

    c_Name = "Faxblatt"

    bFound = False: iCount = 0

    strNewName = c_Name & "_" & Format(Date, "dd-MM-yyyy")

    strName = Dir(c_Path, vbDirectory)     ' Ersten Eintrag abrufen.

    Do While strName <> ""     ' Schleife beginnen.

    If strName <> "." And strName <> ".." Then

        If InStr(1, strName, strNewName) > 0 And GetAttr(c_Path & strName) <> vbDirectory Then

            iCount = iCount + 1

            strTemp = Mid(strName, Len(strNewName) + 2, InStr(1, strName, ".docm") - Len(strNewName) - 2)

            If iMax < CInt(strTemp) Then iMax = CInt(strTemp)

            Debug.Print strName

        End If

    End If

    strName = Dir     ' Nächsten Eintrag abrufen.

    Loop

    iMax = iMax + 1

    strTemp = String(2 - Len(CStr(iMax)), "0") & CStr(iMax)

    strNewName = strNewName & "-" & strTemp ' & ".docm"

    objWord.ActiveDocument.SaveAs c_Path & strNewName

    MsgBox "Die Datei wurde unter folgendem Namen gespeichert:" & vbCrLf & strNewName

    Set objWord = Nothing

    ActiveWindow.SmallScroll Down:=0

    Dim chb As CheckBox

    For Each chb In ActiveSheet.CheckBoxes

    chb.Value = False

    Next

    ActiveSheet.Range("$A$1:$C$100").AutoFilter Field:=1

End Sub

Bei Klicken des Buttons, welcher Makro 12 auslöst, wird die entsprechende Worddatei mit der Wordvorlage und dem Namen erstellt. Allerdings werden die Texte nicht mehr eingefügt, sondern nur noch das hier (egal welche Checkboxen aktiv sind):

Würde mich über jegliche Hilfe freuen.

Danke
Sascha

schotzer