Live-Forum - Die aktuellen Beiträge
Datum
Titel
08.05.2024 23:37:20
Datenverbindung automatisiert aktualisieren
08.05.2024 21:22:24
In vorhandener Formel Jahreszahl mit einbeziehen
08.05.2024 21:15:37
Koordinaten im XY-Diagramm per Cursor ändern.
08.05.2024 19:10:09
doppelte Zeile gem. mehrerer Bedingungen löschen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1824to1828
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1824to1828
1824to1828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Laufzeitfehler 1004

Laufzeitfehler 1004
21.04.2021 11:47:52
Jaymerson
Hallo zusammen!
Ich brauche mal wieder eure Hilfe!
Ich habe da ein Makro das führt zu dem Laufzeitfehler 1004 (Anwendungs- oder objektdefinierter Fehler).
Leider bin ich mit meinem Latein am ende und finde den Fehler nicht.
Kann mir jemand helfen?
Besten dank schon mal vorab
https://www.herber.de/bbs/user/145688.xlsx
Option Explicit

Public Sub SchöneMachen()
'   * * * Erstmal alles hübsch machen * * *
Dim WsTab As Worksheet
For Each WsTab In Sheets
WsTab.Activate
Application.ScreenUpdating = False
'Entferne bei jeder Tabelle die ersten Zeilen bis zu "export"
'da es mal auf englisch, mal auf deutsch dort steht habe ich nur den identischen teil für die suche genutzt
Range("A1").Select
Cells.Find(What:="export", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
'entferne die Fragennummer
Range("B1").FormulaR1C1 = "=RIGHT(RC[-1],LEN(RC[-1])-SEARCH(""_"",RC[-1]))"
Range("B1").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1").ClearContents
'Formatiere a1 mit Schriftgröße, Ausrichtung
Range("A1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Font
.Name = "Helvetica"
.Size = 12
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Formatiere a2 mit Schriftgröße, Ausrichtung, Hintergrundfarbe
Range("A2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.Bold = True
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
'Zeilenhöhe anpassen (für A1 und A2 separat)
Rows.EntireRow.AutoFit
Rows("1:1").RowHeight = 30
Rows("2:2").RowHeight = 15
Columns("a:a").ColumnWidth = 150
Columns("a:a").WrapText = True
Columns("b:f").ColumnWidth = 50
Columns("b:f").WrapText = True
'Entferne alle Rahmen
Cells.Select
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
'Entferne bei jeder Tabelle die Zeile 3
Rows("3:3").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
'A1 und B1 Zellen verbinden
If Range("b3") = "" Then
Range("A1").Select
Else
Range("A3").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(-2, 0).Select
Range(Selection, Selection.End(xlToLeft)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A3").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(-1, 0).Select
Range(Selection, Selection.End(xlToLeft)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End If
'Rahmen neu setzen
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.499984740745262
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.499984740745262
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.499984740745262
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.499984740745262
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.499984740745262
.Weight = xlThin
End With
'Entferne überflüssige Informationen aus Überschrift
Cells.Replace What:=" (Offene Frage)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Replace What:=" (Open End)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Replace What:=" (Single Choice)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Replace What:=" (Mehrfachantwort)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Replace What:=" (Einfachantwort)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
'entferne doppelte Leerzeichen
Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
, FormulaVersion:=xlReplaceFormula2
Next WsTab
Application.ScreenUpdating = True
'   * * * Routine für Hintergrundfarbe A1 * * *
Worksheets(1).Activate
UserForm1.Show
Worksheets(2).Activate
For Each WsTab In Sheets
WsTab.Activate
'Hintergrundfarbe von A1 auf erster Tabelle setzen
Range("a1").Interior.ColorIndex = _
Worksheets(1).Range("a1").Interior.ColorIndex
Next WsTab
Worksheets(1).Activate
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Laufzeitfehler 1004
21.04.2021 12:07:13
Daniel
schwer zu sagen.
den Code testen kann man nicht, weil du die Userform1 nicht mitgeliefert hast.
du solltest dann schon die xlsx-Datei mit allen Bestandteilen mitliefern, die man braucht um den Code bis zum Auftreten des Fehlers testen zu können.
daher solltest du bei Fragen zu einer Fehlermeldung im Code immer ungefragt folgende Informationen mitliefern:
1. wie lautet neben der Fehlernummer der Fehlertext
2. in welcher Zeile tritt der Fehler auf (welche Zeile hat der gelbe Marker)
3. welche Werte haben die in dieser Zeile verwendeten Variablen und Zellen.
einen Code dieser Länge rein theoretisch auf Fehler zu durchsuchen (ohne den Code laufen lassen zu können), ist eine relativ aufwendige Aufgabe, die den Rahmen einer kostenlosen Nachbarschaftshilfe wie sie in einem Forum überlicherweise gegeben wird, überschreitet
Sollte der Fehler in der Zeile "Userform1.Show" auftreten, müsstest du in den Extras - Optionen - Allgemein die Option Unterbrechen bei Fehlern: In Klassenmodul aktivieren und dann nochmal testen und schauen, welche Zeile jetzt den Fehler verursacht.
noch ein Hinweis: wenn du Fragen zu Excel oder VBA hast, ist die Excelversion niemals ohne Relevanz.
mein Excel 2016 kennt beispielsweise die Systemkonstante xlFormulas2 nicht, also schon von daher sollte man wissen, womit du arbeitest.
Gruß Daniel
Anzeige
AW: Laufzeitfehler 1004
21.04.2021 12:39:36
Jaymerson
Hallo Daniel,
schon mal danke für all deine Anmerkungen.
Ich verwende das Excel aus Office 365
In Zeile 159 wird der Fehler angezeigt wenn ich auf Debuggen klicke.
Der code für die Userform lautet:

Private Sub CommandButton2_Click()
'Abbrechen
Unload UserForm1
End Sub


Private Sub Ok_Click()
'orange
If OptionButton1 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
End With
End If
'hellgrün
If OptionButton2 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
End With
End If
'lila
If OptionButton3 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10498160
End With
End If
'dunkelblau
If OptionButton4 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 12611584
End With
End If
'dunkelgrün
If OptionButton5 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
End With
End If
'hellblau
If OptionButton6 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
End With
End If
'rot
If OptionButton7 = True Then
Range("A1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 255
End With
End If
Unload Me
End Sub


Private Sub OptionButton7_Click()
End Sub


Private Sub UserForm_Click()
End Sub

Anzeige
AW: Laufzeitfehler 1004
21.04.2021 12:45:56
Daniel
siehst du hier irgendwo eine 159?
ich nicht.
Gruß Daniel
AW: Laufzeitfehler 1004
21.04.2021 13:07:12
Jaymerson
Sorry, mein Hirn arbeitet heute wohl etwas langsam... (vielleicht ist ja schon das alleine der Fehler?)
Den Code hats ohne Zeilennummern kopiert und ich habe in der VBA umgebung die Zeilennummer aus der Anzeige gelesen... so wirds natürlich nichts.
Diese Zeile hier wärs: " Cells.Replace What:=" (Offene Frage)", Replacement:="", LookAt:=xlPart, _"
Danke für deine Geduld
AW: Laufzeitfehler 1004
21.04.2021 14:28:18
Daniel
Die Zeile sieht für mich korrekt aus
allerdings steht da noch ein "_" am Ende.
Das bedeutet, dass die nächste Zeile im Editor auch noch zu dieser Programmzeile gehört und keine neuer Programmschritt ist.
funktionert es denn, wenn du ersetzen des Texten "(Offene Frage)" von Hand durchführst?
Gruß Daniel
Anzeige

Links zu Excel-Dialogen

CommandButton OptionButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige