AW: VBA - Kommentare laut Liste einfügen
28.10.2017 06:59:07
fcs
Hallo Walter,
hier ein entsprechendes Makro.
Die erforderliche Breite eines Komentar läßt sich nicht so einfach ermitteln.
Gruß
Franz
Option Explicit
Sub Kommentare_einfuegen()
Dim wks_Z As Worksheet
Dim wks_Q As Worksheet
Dim objCom As Comment
Dim strText As String
Dim Zeile_Z As Long
Dim Zelle_Z As Range
Dim Zeile_Q As Long
Dim Zelle_Q As Range
Dim arrSpaQ
Dim spaQ As Integer
Set wks_Q = ActiveWorkbook.Worksheets("QuelleFürDieKommentare")
Set wks_Z = ActiveWorkbook.Worksheets("ZielFürDieKommentare")
With wks_Z
For Zeile_Z = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
Set Zelle_Z = .Cells(Zeile_Z, 1)
If Zelle_Z.EntireRow.Hidden = True Then
'do nothing, da Zeile ausgeblendet
Else
With wks_Q
Set Zelle_Q = .Columns(1).Find(what:=Zelle_Z.Value, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle_Q Is Nothing Then
'vorhandenen Kommentar ggf. löschen, weil in Quelle keine Daten
With Zelle_Z
If Not .Comment Is Nothing Then
.Comment.Delete
End If
End With
Else
'Array mit Reihenfolge der Spalte aus Quelle im Kommentar
arrSpaQ = Array(2, 3, 6, 7, 4, 5)
Zeile_Q = Zelle_Q.Row
'Komentarstext zusammenbasteln
spaQ = LBound(arrSpaQ)
strText = UCase(.Cells(1, arrSpaQ(spaQ)).Text) _
& ": " & .Cells(Zeile_Q, arrSpaQ(spaQ)).Text
For spaQ = LBound(arrSpaQ) + 1 To UBound(arrSpaQ)
strText = strText & vbLf & UCase(.Cells(1, arrSpaQ(spaQ)).Text) _
& ": " & .Cells(Zeile_Q, arrSpaQ(spaQ)).Text
Next spaQ
'Kommentar einfügen und formatieren
With Zelle_Z
If .Comment Is Nothing Then
.AddComment
End If
With .Comment
With .Shape
.Fill.BackColor.RGB = RGB(255, 255, 225)
With .TextFrame.Characters
.Text = strText
With .Font
.Size = 9
.Name = "Segoe UI"
.Bold = False
End With
End With
.Top = Zelle_Z.Top
.Width = Application.CentimetersToPoints(6.5)
.Height = Application.CentimetersToPoints(3.25)
End With
End With
End With
End If
End With
End If
Next Zeile_Z
End With
End Sub