Formatierung wird zurückgesetzt
20.08.2008 17:15:00
sockel939
Nachdem dieser Code am werkeln war, schließe ich den Sheet.
Dann öffne ich ihn wieder und stelle fest, das alle leeren Zellen wieder weiß sind!
Ich frage mich warum, wo der Code doch allen Zellen ne farbe zugewiesen hat.
Die Frage also:
Warum bleiben alle gefüllten Zellen gefärbt und die leeren nicht?
Weiß da jemand ne Antwort ?
Danke schonmal
sockel939
Private Sub CommanButton_click()
Range("A1:M1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.AutoFilter
Dim A As Long
Application.ScreenUpdating = False
For A = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(A, "A") = "" Then
Cells(A, "J").Copy Cells(A - 1, "J")
Rows(A).Delete
End If
Next A
Application.ScreenUpdating = True
Dim Zelle As Range
Dim Farbe As Long
For Each Zelle In Range("m2:m1000")
Select Case Zelle.Value
Case "Morgen"
Farbe = 45
Case "Heute"
Farbe = 42
Case "Mittag"
Farbe = 15
Case "Abend"
Farbe = 43
Case Else
Farbe = xlNone
End Select
Range(Zelle.Offset(0, -Zelle.Column + 1), Zelle.Offset(0, -1)).Interior.ColorIndex = Farbe
Next Zelle
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Grey = Morgen"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Green = Heute"
Range("A3").Select
ActiveCell.FormulaR1C1 = "Orange = Mittag"
Range("A4").Select
ActiveCell.FormulaR1C1 = "Blue = Abend"
Range("A5").Select
Range("A5:M2600").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A4:D4,D3:D4").Select
Range("D4").Activate
ActiveWindow.FreezePanes = True
Range("A4").Select
Rows("4:4").Select
Columns.AutoFit
ActiveWindow.Zoom = 91
Range("A5:M500").Select
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select
ActiveWorkbook.Save
Dim vbc As Object
With Workbooks("exported excelfile.xls").VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End With
End Sub