Thema Datum  Von Nutzer Rating
Antwort
Rot Laufzeitfehler 1004 nach Microsoft update
15.09.2022 19:44:31 Andreas
NotSolved
15.09.2022 20:02:55 Mase
NotSolved
16.09.2022 15:40:28 Gast11401
NotSolved
16.09.2022 16:14:50 Der Steuerfuzzi
NotSolved
16.09.2022 17:41:05 Gast7777
NotSolved

Ansicht des Beitrags:
Von:
Andreas
Datum:
15.09.2022 19:44:31
Views:
281
Rating: Antwort:
  Ja
Thema:
Laufzeitfehler 1004 nach Microsoft update

 

Hallo VBA Community,

seit einigen Tagen habe ich Probleme mit dem Ausführen eines meiner Makros in einem Excel Kalkulations file.

Der "Laufzeitfehler 1004" erscheint kurz vor abschliessen der Transformation und verhindert somit das vollständige Formatieren der Basisdatei in ein geplantes Ausgabeformat für unsere Kunden.

Ich habe das Gefühl, dass dies auf eines der letzten Microsoft Updates zurückzuführen ist und nichts mit dem Quellcode zu tun hat, wecher in den letzten Wochen nicht adaptiert wurde und bis vor wenigen Tagen tadellos funktioniert hat.

Hat jemand von euch ähnliche Erfahrungen gemacht und hat vielleicht einen Lösungsansatz für mich?

P.S. Ich weiiss, der Code ist nicht der eleganteste aber er funktioniert. Bin jedoch für Vorschläge durchaus offen.

 

Beste Grüsse

Andreas


'================================================================================================================
'Kopieren der Kalkulation und Reduzierung auf das Ausgabe-Format für den Kunden mit festen (unveränderlichen) Zahlenwerten
'================================================================================================================
Sub DeviErstellen()
    Dim Response As String
    
    Response = MsgBox("Achtung! Mit diesem Befehl wird die Kalkulation in das Ausgabe-Format für den Kunden übertragen. Hierbei wird ein ggf. bereits bestehendes Devi vollständig Ùberschrieben!", vbOKCancel, "Ausführung bestätigen")
    If Response = vbCancel Then Exit Sub
    
Application.ScreenUpdating = False
    
'Sofern vorhanden, altes Devi loeschen
On Error GoTo NeuesDevi
    Sheets("Kunden-Devi").Select
On Error GoTo 0
    Application.DisplayAlerts = False
    Sheets("Kunden-Devi").Delete
    Application.DisplayAlerts = True
    
NeuesDevi:
    Sheets("KALK").Select
    Sheets("KALK").Copy After:=Sheets("IV")
    Sheets("KALK (2)").Select
    Sheets("KALK (2)").Name = "Kunden-Devi"

'Grafische Anpassung des kopierten KALK-Sheets auf die Ausgabe-Struktur
    ActiveSheet.Unprotect "unchained"
    Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Rows("55:5000").Select
        Selection.UnMerge
    Rows("24:24").Select
        Selection.ClearComments
    Range("G25:R26").Select
        Selection.ClearContents
    Cells.Select
        Selection.FormatConditions.Delete
    Columns("HM:HM").Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:="D"
    Rows("55:5000").Select
        Selection.Delete Shift:=xlUp
        Selection.AutoFilter Field:=1
        Selection.AutoFilter
    Columns("HN:IP").Select
        Selection.Delete
    Columns("S:HL").Select
        Selection.Delete
    Rows("1:74").Select
        Selection.EntireRow.Hidden = False
    Rows("37:74").Select
        Selection.Delete Shift:=xlUp
    Rows("22:23").Select
        Selection.Delete Shift:=xlUp
    Rows("2:19").Select
        Selection.Delete Shift:=xlUp
    Columns("S:S").Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:="V"
        Selection.Activate
    Rows("2:7").Select
        Selection.RowHeight = 21
    Rows("8:14").Select
        Selection.RowHeight = 15
    
    ActiveWindow.FreezePanes = False
    ActiveWindow.DisplayZeros = (ActiveWindow.DisplayZeros = False)
         
    
'Loeschen der Buttons
    If ActiveSheet.Shapes("btnAus").Visible = False Then ActiveSheet.Shapes("btnAus").Visible = True
    If ActiveSheet.Shapes("btnEin").Visible = False Then ActiveSheet.Shapes("btnEin").Visible = True
    ActiveSheet.Shapes("Button 1").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 2").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 3").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 4").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 5").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 6").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 7").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 8").Select
        Selection.Delete
    ActiveSheet.Shapes("Button 9").Select
        Selection.Delete

    ActiveSheet.Rows.Ungroup
    ActiveSheet.Columns.Ungroup
    
'Optische Anpassungen im Kopfbereich
    Range("G2:P4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    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
    Range("B2:P4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    ActiveSheet.Shapes.Range(Array("Picture 14")).Select
    Selection.ShapeRange.IncrementTop 10
    Columns("E:H").EntireColumn.Hidden = True

'Einblenden des Wechselkurses sofern eine andere Ausgabewährung vorhanden ist
    If ActiveSheet.Range("Q6") <> 0 Then
        ActiveSheet.Range("Q4") = "Wechselkurs: 1 " & ActiveSheet.Range("Q6") & " = " & ActiveSheet.Range("r6") & " CHF"
        ActiveSheet.Range("Q4").Select
        With Selection.Font
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0.349986266670736
            .Size = 8
        End With
    End If

'Druck im A4-Format anpassen
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$13"
        .PrintTitleColumns = "$A:$A"
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A:$R"
'    Application.PrintCommunication = False
'    With ActiveSheet.PageSetup
'        .LeftHeader = ""
'        .CenterHeader = ""
'        .RightHeader = "&D"
'        .LeftFooter = "&F"
'        .CenterFooter = ""
'        .RightFooter = "&P | &N"
'        .LeftMargin = Application.InchesToPoints(0.118110236220472)
'        .RightMargin = Application.InchesToPoints(0.118110236220472)
'        .TopMargin = Application.InchesToPoints(0.354330708661417)
'        .BottomMargin = Application.InchesToPoints(0.551181102362205)
'        .HeaderMargin = Application.InchesToPoints(0.118110236220472)
'        .FooterMargin = Application.InchesToPoints(0.31496062992126)
'        .PrintHeadings = False
'        .PrintGridlines = False
'        .PrintComments = xlPrintNoComments
'        .PrintQuality = 600
'        .CenterHorizontally = False
'        .CenterVertically = False
'        .Orientation = xlPortrait
'        .Draft = False
'        .PaperSize = xlPaperA4
'        .Order = xlDownThenOver
'        .BlackAndWhite = False
'        .Zoom = False
'        .FitToPagesWide = 1
'        .FitToPagesTall = False
'        .PrintErrors = xlPrintErrorsDisplayed
'        .OddAndEvenPagesHeaderFooter = False
'        .DifferentFirstPageHeaderFooter = False
'        .ScaleWithDocHeaderFooter = True
'        .AlignMarginsHeaderFooter = True
'    End With
'    Application.PrintCommunication = True

    Range("A1").Select
End Sub

 

 

 

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Laufzeitfehler 1004 nach Microsoft update
15.09.2022 19:44:31 Andreas
NotSolved
15.09.2022 20:02:55 Mase
NotSolved
16.09.2022 15:40:28 Gast11401
NotSolved
16.09.2022 16:14:50 Der Steuerfuzzi
NotSolved
16.09.2022 17:41:05 Gast7777
NotSolved