Re: VBA : bitte anderen Begriff für einen Befehl
13.03.2003 22:05:02
udo
hallo, ja . Hier unten hab ich das Makro des Steuerbuttons mal in zwei Versionen abgebildet, die erste war die originale, und die zweite habe ich versucht etwas abzuändern um sie auf das neue im tabellenblatt anzupassen. Aber wie gesagt füre ich dies aus geht der Debugger vom Tab.Makro an.
Ich steig da leider nicht durch. Vielleicht könnst du mir nen Rat geben oder erkennst du es, Danke trotzdem mal.
udo
Sub Markierungsfelder_färben_ein()
range("A9").Select
If Selection = "" Then
ActiveCell.FormulaR1C1 = "1"
ActiveSheet.Shapes("Rectangle 6131").Select
Selection.OnAction = "Autofilter_x"
Application.ScreenUpdating = False
range("G12:G507").Select
Selection.Locked = False
Selection.FormulaHidden = False
With Selection.Font
.Name = "Wingdings 2"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 55
End With
With Selection.Font
.Name = "Wingdings 2"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 55
End With
Selection.Interior.ColorIndex = 2
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
Selection.Font.ColorIndex = 55
ActiveSheet.Shapes("AutoShape 4905").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 48
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.OneColorGradient msoGradientMixed, msoIntegerMixed, _
0.53
range("H12").Select
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
ActiveSheet.EnableAutoFilter = True
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
range("A10").Select
ActiveCell.FormulaR1C1 = "6"
ActiveSheet.EnableAutoFilter = True
Selection.AutoFilter Field:=1, Criteria1:="<>"
range("h12:h507").Select
Selection.ClearContents
range("H12").Select
ActiveSheet.Shapes("AutoShape 4905").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 20
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.OneColorGradient msoGradientMixed, msoIntegerMixed, _
0.53
range("A9").Select
Selection.clear
range("G12:G507").Select
Selection.clear
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = 16
Selection.Font.ColorIndex = 16
range("H12").Select
Application.ScreenUpdating = True
End If
End Sub
Sub Markierungsfelder_färben_ein1()
range("A9").Select
If Selection = "" Then
ActiveCell.FormulaR1C1 = "1"
ActiveSheet.Shapes("Rectangle 6131").Select
Selection.OnAction = "Autofilter_x"
Application.ScreenUpdating = False
range("G12").Select
Selection.Locked = False
Selection.FormulaHidden = False
With Selection.Font
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 55
End With
Selection.Interior.ColorIndex = 2
Selection.copy
Do Until Cells(16, 7)
'range("G13").Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
ActiveSheet.Paste
Loop
ActiveSheet.Shapes("AutoShape 4905").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 48
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.OneColorGradient msoGradientMixed, msoIntegerMixed, _
0.53
range("H12").Select
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
ActiveSheet.EnableAutoFilter = True
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
range("A10").Select
ActiveCell.FormulaR1C1 = "6"
ActiveSheet.EnableAutoFilter = True
Selection.AutoFilter Field:=1, Criteria1:="<>"
range("h12:h507").Select
Selection.ClearContents
range("H12").Select
ActiveSheet.Shapes("AutoShape 4905").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 20
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Fill.OneColorGradient msoGradientMixed, msoIntegerMixed, _
0.53
range("A9").Select
Selection.clear
range("G12").Select
Do Until Cells(16, 7)
Selection.clear
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
'Selection.Interior.ColorIndex = 16
'Selection.Font.ColorIndex = 16
Loop
range("H12").Select
Application.ScreenUpdating = True
End If
End Sub