Formatierung wird zurückgesetzt

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Formatierung wird zurückgesetzt

Formatierung wird zurückgesetzt von sockel939 vom 20.08.2008 17:15:16

doppelt - von zu am 20.08.2008 17:23:57

Betrifft: Formatierung wird zurückgesetzt von: sockel939
Geschrieben am: 20.08.2008 17:15:16

Hallo Leute,

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