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ß,
|