Office: Makro Problem (Laufzeitfehler 1004)

Hallo liebe Forengemeinde,

ich habe mich hier angemeldet da ich seit einiger Zeit
mit einem Problem kämpfe wofür ich einfach keine Lösung finde.

Auf Arbeit benutze ich Excel 2010. Zum erzeugen von bestimmten
Daten habe ich dafür ein Makro einer bestimmten Firma
(bzgl. dem erzeugen von Schachtuhren in der Kanalplanung)

Versuche ich nun dieses Makro auszuführen bekomme ich folgende Meldung:

Laufzeitfehler '1004': Die Background-Eigenschaft des Font-Objektes kann nicht festgelegt werden:

Wechsel ich nun zu "Debuggen" erscheint im Menü folgender Text:

Code:

Sub Schachtuhr_erzeugen()
'
' Test1 Makro
' Makro am 17.07.00 von Thomas Brockmann aufgezeichnet
'

'
    
    Application.ScreenUpdating = False
    Selection.Copy
    Rows("5:5").Select
    ActiveSheet.Paste
    Range("D5").Select
    Shoe = ActiveCell.Value
    Range("D5").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("C5").Select
    SDN = ActiveCell.Value
    Range("A5").Select
    Schacht = ActiveCell.Value
    Application.StatusBar = "Schachtuhr " & Schacht & " wird generiert -> running   ||||"
    Range("H5").Select
    Swin = ActiveCell.Value
    Stab = "Schachtuhr " & Schacht
    Sheets("Schachtliste").Copy Before:=Sheets(1)
    Sheets("Schachtliste (2)").Select
    Sheets("Schachtliste (2)").Name = Stab
    Cells.Select
    Selection.ClearContents
    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 = xlNone
    Sheets(Stab).Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Schachtuhr für Schacht " & Schacht
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ' Range("D1").Select
    ' ActiveCell.FormulaR1C1 = netz
    Range("D1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Durchmesser:"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = SDN
    Range("E1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D1").Select
    Range("D1").Select
    Selection.NumberFormat = "@"
    Sheets("Schachtliste").Select
    Range("A5").Select
    Selection.Copy
    Sheets(Stab).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("G1").Select
    Sheets("Schachtliste").Select
    Range("C5").Select
    Selection.Copy
    Sheets(Stab).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Schachtuhr für Schacht: "
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Winkel gegen Nord:"
    Range("H1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("J1").Select
    Sheets("Schachtliste").Select
    Range("H5").Select
    Selection.Copy
    ActiveWindow.WindowState = xlNormal
    ' Windows("Schachtliste.CSV").Activate
    Sheets(Stab).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ActiveWindow.WindowState = xlNormal
    ' Windows("Schachtliste.CSV").Activate
    Sheets(Stab).Select
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "1. Auslauf"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "2. Auslauf"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "1. Einlauf"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "e"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "2. Einlauf"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "3. Einlauf"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "4. Einlauf"
    Range("F4").Select
    ActiveWindow.Zoom = 100
    Rows("3:3").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("A4").Select
    Sheets("Schachtliste").Select
    Range("H5,K5,N5,Q5,T5").Select
    Range("T2").Activate
    ' ActiveWindow.SmallScroll ToRight:=2
    Range("H5,K5,N5,Q5,T5,W5").Select
    Range("W5").Activate
    Selection.Copy
    Sheets(Stab).Select
    ActiveSheet.Paste
    Sheets("Schachtliste").Select
    Range("F5,I5,L5,O5,R5,U5").Select
    Range("U5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Range("D63").Select
    Sheets(Stab).Select
    Range("A5").Select
    ActiveSheet.Paste
    Sheets("Schachtliste").Select
    Range("G5,J5,M5,P5,S5,V5").Select
    Range("V5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(Stab).Select
    Range("A6").Select
    ActiveSheet.Paste
    Range("A3:F3").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("A7").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(T(R[-4]C),"", "",TEXT(R[-3]C,""0,0""),""gon, "",TEXT(R[-2]C,0),""mm, "",TEXT(R[-1]C,""0,00""),""mNN"")"
    Range("A7:F7").Select
    Selection.FillRight
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "=R[-4]C/400*100"
    Range("A8:F8").Select
    Selection.FillRight
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C[9]-R[-3]C[9]"
    Range("A3:F8").Select
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
    Range("A3:F8").Select
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C-R[-1]C[-1]"
    Range("B9:F9").Select
    Selection.FillRight
    Range("G9").Select
    ActiveCell.FormulaR1C1 = "=100-R[-1]C[-1]"
    Range("A7:G7,A9:G9").Select
    Range("A9").Activate
    Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.SetSourceData Source:=Sheets(Stab).Range("A7:G7,A9:G9" _
        ), PlotBy:=xlRows
    ActiveChart.Location Where:=xlLocationAsObject, Name:=Stab
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = Stab
    End With
    ActiveChart.HasLegend = False
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabel, LegendKey:=False, _
        HasLeaderLines:=False
    ActiveSheet.Shapes("Diagramm 1").IncrementLeft -165#
    ActiveSheet.Shapes("Diagramm 1").IncrementTop -8.25
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.46, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Diagramm 1").ScaleHeight 1.46, msoFalse, _
        msoScaleFromTopLeft
    ActiveChart.ChartTitle.Select
    Selection.Left = 9
    ActiveChart.ChartArea.Select
    With Selection.Border
        .ColorIndex = 57
        .Weight = 4
        .LineStyle = 1
    End With
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = 1
    End With
    Sheets(Stab).DrawingObjects("Diagramm 1").RoundedCorners = False
    Sheets(Stab).DrawingObjects("Diagramm 1").Shadow = False
    ActiveChart.PlotArea.Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlNone
    End With
    Selection.Interior.ColorIndex = xlNone
    ActiveChart.SeriesCollection(1).Select
    With Selection.Border
        .ColorIndex = 57
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    Selection.Shadow = False
    Selection.Interior.ColorIndex = xlNone
    ActiveChart.Shapes.AddLine(3.75, 30.75, 314.25, 33#).Select
    Selection.ShapeRange.Flip msoFlipVertical
    Selection.Delete
    ActiveChart.Shapes.AddLine(3#, 39#, 289.5, 39#).Select
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).DataLabels.Select
    ActiveChart.Shapes("Line 2").Select
    Selection.ShapeRange.Line.Weight = 2#
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Line.BeginArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNone
    ActiveChart.ChartArea.Select
    With ActiveChart.TextBoxes.Add(326, 206, 192, 41)
        .Select
        .AutoSize = True
        .Text = "Durchmesser: " & SDN & Chr(10) & "1. Auslauf - Richtung: " & Swin & "gon"
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Orientation = xlHorizontal
        .AutoSize = True
    End With
    Selection.ShapeRange.IncrementLeft -315.75
    Selection.ShapeRange.IncrementTop -149.25
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Standard"
        .Size = 14.75
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
        [COLOR=#FF0000].Background = xlTransparent[/COLOR]    
    End With
   ....
End Sub

Die markierte Zeile wird mir auch markiert im Debug-Menü angezeigt.

Kann sich irgendjemand daraus etwas nehmen und mir evtl. weiterhelfen?
Es scheint ein Problem mit Excel 2010 zu sein, da es wohl bei älteren
Versionen problemlos läuft.

Danke schonmal an euch.

MfG Nico

 

So ich hab das jetzt mal etwas übersichtlicher gemacht. Bitte in Zukunft die "Code" Funktion beim Posten benutzen Nico. Du findest diese unter erweitert.

 

Also der Code an sich ist in Ordnung. Wahrscheinlich liegt es an dem Objekt das gerade ausgewählt ist. Kannst Du mir sagen welches Objekt oder welche Zelle oder was auch immer grade markiert ist wenn der Fehler auftritt, oder kannst Du die Datei hochladen in der du das Makro ausführst.

 

Sorry das ich mich jetzt erst wieder melde,
ich habe nach wie vor Interesse daran das Problem zu lösen.

Der Arbeitsstreß hatte mir jedoch keine Zeit gegeben hier rein zu schauen.

Markiert ist die Zeil ".Background = xlTransparent"

Ich kann die Datei hochladen? Gibt es da eine Plattform bei der sich dies anbietet?

 

Hi Nico,

unter dem Antwortfenster rechts findest du den Schalter "Erweitert". Daraufhin öffnet sich unterhalb des Antwortfensters ein neuer Bereich "Zusätzliche Einstellungen", u.a. mit einem Schalter "Anhänge verwalten". Dort kannst du deine Mappe dann hochladen.

Bis später,
Karin

 

Danke schonmal.

Leider benötigt die Mappe eine andere Datei,
auf welche Sie zugreift. Hier kann man aber
scheinbar nur .xls Mappen hochladen?

Hier mal ein Downloadlink:

http://www.file-upload.net/download-4169252/Schachtuhr.rar.html

Wenn man alles entpackt hat müssen die .xls und die .csv in einem Ordner sein.

Jetzt kann man die .xls öffnen und wird nach einer Netznummer gefragt.
Hier bitte "1" eingeben. Damit wird auf die .csv Datei zugegriffen.

Jetzt müsste eine Tabelle erscheinen. Hier muss man nun eine der angezeigten
Schachtzeilen markieren (z.B. S1) und Strg + S drücken.

Und genau da kommt dann bei mir der Fehler.
Im Normalfall sollte eine Art Kreisdiagramm erzeugt werden.

MfG Nico

 

Hi Nico,

ich kann mir die Mappe leider nicht ansehen, da ich keine RAR-Dateien öffnen kann (nur ZIP).

Bis später,
Karin

 

Hallo Nico,

ich kann Dir zwar nicht sagen wo der Fehler liegt,
aber bei mir kommt dieser Fehler:



Vielleicht hilft Dir das ja weiter?