AW: Änderung an den Kommentarfeldern
09.06.2004 21:04:11
Andy
Hallo Chris,
das Problem des Jahres habe ich gelöst. Nur mit der Formatierung habe ich noch Probleme.
Jetzt sieht das so aus:
Sub Notiz_Geburtstag()
Dim Alter As Byte
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iiZeile As Long
Application.ScreenUpdating = False
Set WS1 = Worksheets("Dienstplan")
Set WS2 = Worksheets("Geburtstage")
'Selection.ShapeRange.ScaleWidth 1.74, msoFalse, msoScaleFromTopLeft
ActiveSheet.Unprotect Password:=""
For iZeile = 1 To WS1.Range("A65536").End(xlUp).Row
If Not WS1.Cells(iZeile, 1).Comment Is Nothing Then WS1.Cells(iZeile, 1).ClearComments
Next iZeile
For iZeile = 4 To WS2.Range("B65536").End(xlUp).Row
For iiZeile = 2 To WS1.Range("A65536").End(xlUp).Row
If Day(WS1.Cells(iiZeile, 1)) = Day(WS2.Cells(iZeile, 3)) And _
Month(WS1.Cells(iiZeile, 1)) = Month(WS2.Cells(iZeile, 3)) Then Exit For
Next iiZeile
With WS1.Cells(iiZeile, 1)
Alter = Year(WS1.Cells(iiZeile, 1)) - Year(WS2.Cells(iZeile, 3))
If .Comment Is Nothing Then
.AddComment WS2.Cells(iZeile, 2).Value & ": " & Chr(10) & Alter & " Jahre"
.Comment.Visible = True
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Orientation = xlHorizontal
' .AutoSize = True
End With
With .Comment.Shape
.Fill.ForeColor.SchemeColor = 41
.Fill.Transparency = 0#
.Line.Weight = 0.75
' .Line.DashStyle = msoLineSolid
' .Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
.Shadow.ForeColor.SchemeColor = 6
End With
Else
.Comment.Text Text:=.Comment.Text & Chr(10) & WS2.Cells(iZeile, 2).Value & ": " & Chr(10) & Alter & " Jahre"
End If
End With
Next iZeile
Application.ScreenUpdating = True
ActiveSheet.Protect Password:=""
End Sub
Die Formatierung ist in dem Feld, was ======== gesperrt ist. Warum bekomme ich
das nicht so hin bzw. ich hatte heute eine Schöne Formatierung:
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
Selection.ShapeRange.Line.Weight = 1.5
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 70.5
Selection.ShapeRange.Width = 113.25
Aber da stürzt mir das ganze Excel ab, wenn ich die einbaue.
Hast du noch eine Idee, dass würde mich sehr freuen.
Gruß
Andy
