Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Help please -- Makro kopieren

Betrifft: Help please -- Makro kopieren von: sockel939
Geschrieben am: 20.08.2008 11:26:34

Hallo Leute,
mit diesem code lösche ich nach der Prozedur alle Makros!

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

Wie aber schafft man es diesen Code:

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

danach wieder in den Sheet einzufügen?

Beide Codes sind bestandteil einer ganzen Reihe, ausgelöst durch CommandButton,
Möchte alle codes die ausgelöst wurden am ende löschen (siehe den ersten oben) anschließend den zweiten hier aber in meine Tabelle einfügen.

Ich weiß das ist ne heiden Arbeit und ich habe schon das Orakel befragt ohne ende aber ich kriegs nicht hin.

Bin Dankbar für jede erdenkliche Lösung.

  

Betrifft: AW: Help please -- Makro kopieren von: Daniel
Geschrieben am: 20.08.2008 11:48:12

Hi

erstelle eine Vorlagenblatt, das nur den gewünschten Code in seinem Modul enhält.

beim erstellen der Export-Datei kopierst du dann das leere Vorlagenblatt in eine neuen Datei und dann die Daten per Copy-Paste aus dem Originalblatt in die neue Datei.

dann ersparst du dir das Löschen und Einfügen der Makros

Gruß, Daniel


  

Betrifft: AW: Help please -- Makro kopieren von: sockel939
Geschrieben am: 20.08.2008 12:15:55

Ok ! Werd das mal machen!

Eine Frage noch wieso sind alle Zellen in denen nix steht nach erneutem öffnen wieder weiß?
Hab denen doch ne Farbe zugewiesen.
Werden die Formatierungen nicht mitgespeichert?


  

Betrifft: AW: Help please -- Makro kopieren von: Daniel
Geschrieben am: 20.08.2008 12:21:04

Hi
ich kenne weder deine Datei, noch dein Makro und meine Glaskugel ist kaputt.
Gruß, Daniel


  

Betrifft: AW: Help please -- Makro kopieren von: sockel939
Geschrieben am: 20.08.2008 12:32:12

Mein Code

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



Naja jedenfalls werden die vergebenen Farben nicht mitgespeichert :(


 

Beiträge aus den Excel-Beispielen zum Thema "Help please -- Makro kopieren"