Fehler beim Ausführen eines Makros
28.01.2015 10:46:12
Felix
ich habe ein Problem und komme nicht so richtig weiter...
Ich habe mir zwei Makros geschrieben. Sie haben vom Prinzip her die gleiche Funktion. Sie fügen beide in einem bestimmten Bereich eine Tabelle ein. Der Unterschied ist nur, dass sie unterschiedliche Farben haben.
Jetzt führe ich ein Makro aus und es funktioniert auch alles so, wie ich es gerne möchte. Aber sobald ich das Makro erneut ausführe kommt eine Fehlermeldung und es funktioniert nicht mehr.
Ich glaube, dass es daran liegt, dass der Name der Tabelle die eingefügt wird immer "Tabelle1" ist. Aber ich weis nicht, falls das der Fehler ist, wie ich ihn ausmerzen kann. z.B. Dass der Name der Tabelle sich automatisch erweitert (ungefähr so: Tabelle1; Tabelle2; Tabelle3; Tabelle4 usw....).
Der genau Fehler der auftaucht ist folgender (falls jemand den wissen muss):
Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler
Hier ist das Makro, dass ich mir geschrieben habe:
Sub Okay()
'Bereich in dem die Tabelle eingefügt werden soll, wird nun markiert
ActiveCell.Select
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Resize(1, 16).Select
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Resize(2, 16).Select
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Resize(3, 16).Select
'Der Bereich wurde markiert und jetzt soll die Tabelle in dem Bereich eingefügt werden
ActiveSheet.ListObjects.Add(xlSrcRange, , xlNo).Name = _
"Tabelle1"
Range("Tabelle1[#All]").Select
ActiveSheet.ListObjects("Tabelle1").TableStyle = "TableStyleLight16"
ActiveSheet.ListObjects("Tabelle1").ShowHeaders = False
'Die Tabelle wurde an dem markiertem Bereich eingefügt
'Jetzt wird die Zeile über der frisch eingefügten Tabelle markiert
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 0).Select
ActiveCell.Offset(-1, 0).Select
ActiveCell.Select
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Resize(1, 16).Select
'Nun wird der markierte Bereich verbunden und zentriert
'Außerdem wird er eine Hintergrundfarbe und ein Gitternetz bekommen
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
End Sub
Gruß
Felix