Probleme mit Auslesen von Kommentaren

  • Excel

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von blgUcjnl.

    Probleme mit Auslesen von Kommentaren

    Hallo zusammen,

    ich brauche mal eure Hilfe. Mit dem Code unten sollen alle Kommentare auf der betroffenen Seite ausgelesen und untereinander sortiert auf einem anderen Tabellenblatt kopiert werden.
    Jetzt zum Problem: Ich habe jetzt auf der Seite auch Kommentare die nicht ausgelesen weerden sollen. Er soll nur die Kommentare auslesen aus der Range (Set adr = .Range(.Cells(3, 8), .Cells(3, 33)))
    Ich weiß aber nicht wie ich die Zeile (For Each cmtDieser In wksMitKommentaren.Comments) umschreiben muss. Egal was ich versucht habe, ich bekomme immer Fehlermeldungen, haupotsaächlich Fehler 1004.
    Bin noch Anfänger im Bereich VBA, hoffe ihr habt eine Idee. Danke schonmal im vorraus


    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wksMitKommentaren As Worksheet 'die Tabelle mit Kommentaren
    Dim wksAusdruck As Worksheet 'die Tabelle zum Auflisten der Kommentare
    Dim cmtDieser As Comment 'ein Kommentar
    Dim lngZeile As Long
    Dim adr As Range
    Dim a1 As Long

    Set wksMitKommentaren = ActiveSheet
    Set wksAusdruck = ThisWorkbook.Worksheets("Ereignisse")

    With wksMitKommentaren
    Set adr = .Range(.Cells(3, 8), .Cells(3, 33))
    End With

    wksMitKommentaren.Activate

    With wksAusdruck 'Titelzeile schreiben:
    lngZeile = 2
    .Cells(lngZeile, 1).Value = "Datum"
    .Cells(lngZeile, 2).Value = "Ereigniss"
    .Rows(lngZeile).Font.Bold = True 'Titelzeile fett machen

    For Each cmtDieser In wksMitKommentaren.Comments 'alle Kommentare durchlaufen und in neuer Tabelle auflisten
    lngZeile = lngZeile + 1
    a1 = cmtDieser.Parent.Column
    .Cells(lngZeile, 1).Value = "Monat: " & wksMitKommentaren.Name & " // Tag: " & wksMitKommentaren.Cells(6, a1).Value
    .Cells(lngZeile, 2).Value = cmtDieser.Text
    Next
    End With

    End Sub

    Folgendes funktioniert bei mir:

    Mit nachfolgendem Code lassen sich die Kommentare zu jeder einzelnen Spalte der Tabelle mit Kommentaren auf jeweils ein neues Tabellenblatt "Kommentare_Spalte_C" usw. schreiben:

    Tabellenname und Spalte sind vor der Ausführung des Makros entsprechend anzupassen.

    Visual Basic-Quellcode

    1. Sub KommentareInNeuesBlattSchreiben()
    2. Dim wksMitKommentaren As Worksheet 'die Tabelle mit Kommentaren
    3. Dim wksAusdruck As Worksheet 'die Tabelle zum Ausdrucken
    4. Dim cmtDieser As Comment 'ein Kommentar
    5. Dim lngZeile As Long
    6. Dim WatchRange As Range
    8. Set wksMitKommentaren = ActiveSheet 'Achtung, vorher merken, weil neues Blatt kommt
    9. Set wksAusdruck = ThisWorkbook.Worksheets.Add() 'macht eine neue Tabelle
    10. ActiveSheet.Name = "Kommentare_Spalte_C" 'Tabellenname passend zur Spalte ändern
    12. Set WatchRange = wksMitKommentaren.Range("C:C") 'nacheinander Tabellenspalte ändern
    14. With wksAusdruck
    15. 'Titelzeile schreiben:
    16. lngZeile = 1
    17. .Cells(lngZeile, 1).Value = "Adresse1" 'vor jeden führenden Punkt wird wksAusdruck gesetzt wegen "With"
    18. .Cells(lngZeile, 2).Value = "Adresse2"
    19. .Cells(lngZeile, 3).Value = "Zellwert"
    20. .Cells(lngZeile, 4).Value = "Kommentar"
    21. .Cells(lngZeile, 5).Value = "Transparenz"
    22. .Rows(lngZeile).Font.Bold = True 'Titelzeile fett machen
    24. For Each cmtDieser In wksMitKommentaren.Comments
    25. If Not Intersect(cmtDieser.Parent, WatchRange) Is Nothing Then
    26. lngZeile = lngZeile + 1
    27. .Cells(lngZeile, 1).Value = "A" & lngZeile
    28. .Cells(lngZeile, 2).Value = cmtDieser.Parent.AddressLocal
    29. .Cells(lngZeile, 3).Value = cmtDieser.Parent.Value
    30. .Cells(lngZeile, 4).Value = cmtDieser.Text
    31. .Cells(lngZeile, 5).Value = cmtDieser.Shape.Fill.Transparency
    32. End If
    33. Next
    34. End With
    35. End Sub


    Mit nachfolgendem Code lassen sich die Hyperlinks in die Tabelle mit den Kommentaren schreiben:

    In der Tabelle mit den Kommentaren ist manuell jeweils eine leere Spalte für die Hyperlinks einzufügen, weil beim Einfügen der Hyperlinks der Zelleninhalt überschrieben wird. Die Adresse2 in der Tabelle "Kommentare_Spalte_C" usw. ist vor der Ausführung des Makros entsprechend anzupassen.

    Visual Basic-Quellcode

    1. Sub HyperlinkaufandereTabelleeinfügen()
    2. 'Tabellenname passend zu Spalte ändern
    3. Dim lngZeile As Long
    4. With Worksheets("Kommentare_Spalte_C")
    5. For lngZeile = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
    6. Range(CStr(Sheets("Kommentare_Spalte_C").Cells(lngZeile, 2))).Select
    7. ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="" & "Kommentare_Spalte_C!" & CStr(Sheets("Kommentare_Spalte_C").Cells(lngZeile, 1)) _
    8. , TextToDisplay:=CStr(Sheets("Kommentare_Spalte_C").Cells(lngZeile, 1))
    9. Next
    10. End With
    11. End Sub


    Werden diese beiden Module in der PERSONAL.XLSB gespeichert ist eine kleine Änderung erforderlich:

    Visual Basic-Quellcode

    1. Set wksAusdruck = ThisWorkbook.Worksheets.Add() 'macht eine neue Tabelle
    muss durch

    Visual Basic-Quellcode

    1. Set wksAusdruck = ActiveWorkbook.Worksheets.Add() 'macht eine neue Tabelle
    ersetzt werden.

    Mit nachfolgendem Code lassen sich die Kommentare zu jeder einzelnen Spalte der Tabelle mit Kommentaren auf jeweils ein neues Tabellenblatt "Kommentare_Spalte_C" usw. schreiben:

    Tabellenname und Spalte sind vor der Ausführung des Makros entsprechend anzupassen.

    Visual Basic-Quellcode

    1. Sub KommentareInNeuesBlattSchreiben()
    2. Dim wksMitKommentaren As Worksheet 'die Tabelle mit Kommentaren
    3. Dim wksAusdruck As Worksheet 'die Tabelle zum Ausdrucken
    4. Dim cmtDieser As Comment 'ein Kommentar
    5. Dim lngZeile As Long
    6. Dim WatchRange As Range
    8. Set wksMitKommentaren = ActiveSheet 'Achtung, vorher merken, weil neues Blatt kommt
    9. Set wksAusdruck = ActiveWorkbook.Worksheets.Add() 'macht eine neue Tabelle
    10. ActiveSheet.Name = "Kommentare_Spalte_C" 'Tabellenname passend zur Spalte ändern
    12. Set WatchRange = wksMitKommentaren.Range("C:C") 'nacheinander Tabellenspalte ändern
    14. With wksAusdruck
    15. 'Titelzeile schreiben:
    16. lngZeile = 1
    18. .Cells(lngZeile, 1).Value = "Adresse1"
    19. 'vor jeden führenden Punkt wird wksAusdruck gesetzt wegen "With"
    20. .Cells(lngZeile, 2).Value = "Adresse2"
    21. .Cells(lngZeile, 3).Value = "Zellwert"
    22. .Cells(lngZeile, 4).Value = "Kommentar"
    23. .Cells(lngZeile, 5).Value = "Transparenz"
    24. .Rows(lngZeile).Font.Bold = True 'Titelzeile fett machen
    26. For Each cmtDieser In wksMitKommentaren.Comments
    27. If Not Intersect(cmtDieser.Parent, WatchRange) Is Nothing Then
    28. lngZeile = lngZeile + 1
    29. .Cells(lngZeile, 1).Value = "A" & lngZeile
    30. .Cells(lngZeile, 2).Value = cmtDieser.Parent.AddressLocal
    31. .Cells(lngZeile, 3).Value = cmtDieser.Parent.Value
    32. .Cells(lngZeile, 4).Value = cmtDieser.Text
    33. .Cells(lngZeile, 5).Value = cmtDieser.Shape.Fill.Transparency
    34. End If
    35. Next
    36. End With
    37. End Sub


    Mit nachfolgendem Code lassen sich die Hyperlinks in die Tabelle mit den Kommentaren schreiben:

    In der Tabelle mit den Kommentaren ist manuell jeweils eine leere Spalte für die Hyperlinks einzufügen, weil beim Einfügen der Hyperlinks der Zelleninhalt überschrieben wird. Die Adresse2 in der Tabelle "Kommentare_Spalte_C" usw. ist vor der Ausführung des Makros entsprechend anzupassen.

    Visual Basic-Quellcode

    1. Sub HyperlinkaufandereTabelleeinfügen()
    2. 'Tabellenname passend zu Spalte ändern
    3. Dim lngZeile As Long
    4. With Worksheets("Kommentare_Spalte_C")
    5. For lngZeile = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
    6. Range(CStr(Sheets("Kommentare_Spalte_C").Cells(lngZeile, 2))).Select
    8. ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
    9. SubAddress:="" & "Kommentare_Spalte_C!" &
    10. CStr(Sheets("Kommentare_Spalte_C").Cells(lngZeile, 1)) _
    11. , TextToDisplay:=CStr(Sheets("Kommentare_Spalte_C").Cells(lngZeile, 1))
    12. Next
    13. End With
    14. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „blgUcjnl“ ()

Facebook
Telefonspende