Option Explicit
Sub Test()
Const clng_ZEILE As Long = 2
Const clng_SPALTE As Long = 2
Dim lngRow As Long
lngRow = 11
Call TestKommentar(lngRow, clng_ZEILE, clng_SPALTE)
End Sub
Private Sub TestKommentar(ByVal DATENAUS As Long, _
ByVal INZELE As Long, INSPALTE As Long)
Const cstr_QUELLE As String = "Tabelle1"
Const cstr_ZIEL As String = "Tabelle2"
Const clng_Kspalte As Long = 15
Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim rng2 As Range
Dim cmt2 As Comment
Dim shp2 As Object
Dim strText As String
Dim intText As Integer
With ThisWorkbook
Set wsh1 = .Sheets(cstr_QUELLE)
Set wsh2 = .Sheets(cstr_ZIEL)
End With
Set rng2 = wsh2.Cells(INZELE, INSPALTE)
On Error Resume Next
rng2.Comment.Delete
On Error GoTo 0
Set cmt2 = rng2.AddComment
Set shp2 = cmt2.Shape
With shp2
With .TextFrame
strText = TestZeile(wsh1.Cells(1, 2), wsh1.Cells(1, 3), clng_Kspalte)
intText = Len(strText)
.Characters(1, intText).Text = strText
.Characters(1, intText).Font.Bold = True
intText = intText + 1
.Characters(intText, 1).Text = vbLf
strText = TestZeile(wsh1.Cells(DATENAUS, 2), wsh1.Cells(DATENAUS, 3), clng_Kspalte)
.Characters(intText, Len(strText)).Text = strText
.Characters(intText, Len(strText)).Font.Bold = False
intText = intText + Len(strText) + 1
.Characters(intText, 1).Text = vbLf
intText = intText + 1
.Characters(intText, 1).Text = vbLf
strText = TestZeile(wsh1.Cells(1, 9), wsh1.Cells(1, 4), clng_Kspalte)
.Characters(intText, Len(strText)).Text = strText
.Characters(intText, Len(strText)).Font.Bold = True
intText = intText + Len(strText) + 1
.Characters(intText, 1).Text = vbLf
strText = TestZeile(wsh1.Cells(DATENAUS, 9) & wsh1.Cells(DATENAUS, 10), wsh1.Cells(DATENAUS, 4), clng_Kspalte)
.Characters(intText, Len(strText)).Text = strText
.Characters(intText, Len(strText)).Font.Bold = False
intText = intText + Len(strText) + 1
Rem **********************************************************************
Rem am besten den Aufbau nach festen (Spalten) Breiten und Schriftart
Rem **********************************************************************
With .Characters.Font
.Name = "Courier New"
.Size = 10
End With
End With
.Height = 160
.Width = 160
End With
End Sub
Private Function TestZeile(ByVal WERT1 As Variant, _
ByVal WERT2 As Variant, ByVal BREITE As Long) As String
Dim strZeile As String
strZeile = Left(CStr(WERT1) & String(BREITE, " "), BREITE)
strZeile = strZeile & Left(CStr(WERT2) & String(BREITE, " "), BREITE)
TestZeile = strZeile
End Function