|  
                                             
	Hallo, 
	 
	sowas könnte gehen; 
	die ganzen Blanks kannst Du mit der String-Funktion 
	kürzer fassen: 
Option Explicit
Private strKommentar As String
Public Sub InhaltAuslesen(ByVal intRow As Integer)
Dim strBlattname As String    ' noch zuzuweisen ......
 With Worksheets(strBlattname)
    strKommentar = _
    .Cells(1, 2).Value & String$(10, " ") & .Cells(1, 3).Value & Chr(10) _
    & .Cells(intRow, 2).Value & String$(12, " ") & .Cells(intRow, 3).Value & Chr(10) & Chr(10) _
    & .Cells(1, 9).Value _
    & String$(20, " ") _
    & .Cells(1, 4).Value & Chr(10) _
    & .Cells(intRow, 9).Value & .Cells(intRow, 10).Value _
    & String$(16, " ") _
    & .Cells(intRow, 4).Value & Chr(10) & Chr(10) _
    & .Cells(1, 6).Value & Chr(10) & .Cells(intRow, 6).Value & Chr(10) & Chr(10) _
    & .Cells(1, 5).Value & Chr(10) & .Cells(intRow, 5).Value & Chr(10) & Chr(10) _
    & .Cells(1, 8).Value & Chr(10) & .Cells(intRow, 8).Value & Chr(10) _
    & .Cells(1, 7).Value & Chr(10) & .Cells(intRow, 7).Value
End With
End Sub
Public Sub CreateComment()
 With Worksheets("Monate " & Year(DatZeile)).Cells(b, c).AddComment(strKommentar).Shape.TextFrame.Characters.Font
    .Bold = True
    .Underline = xlUnderlineStyleSingle
End With
End Sub
	Gruß, 
     |