Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1828to1832
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
Inhaltsverzeichnis

If ohne End If Block

If ohne End If Block
10.05.2021 19:06:44
MarcoH
Hallo Zusammen,
ich habe ein kleines Problem mit der Fehlermeldung If ohne End If Block. Meines Erachtens habe ich alle erforderlichen End Ifs gesetzt. Vielleicht bin ich bei dem langen Code auch einfach nur blind geworden.
Bei der Fehlermeldung ist der Sub und End Sub gelb markiert.
Ich habe bereits einiges probiert, jedoch keinen Fehler etc gefunden.
Ich hoffe, dass ihr mir helfen könnt.
Die Datei kann ich aufgrund der sehr sensiblen Daten und auch Tabellen nicht einstellen. Ich hoffe, dass der Code an sich genügt.
Vielen Dank im Voraus für die Hilfe!!
Hier der Code:

Sub BesiProtokoll_verwalten()
' 1. Verwalten und in das Betriebsbuch übertragen
Worksheets("Protokoll").Visible = True
Worksheets("Protokoll").Activate
Worksheets("Protokoll").Unprotect
Worksheets("Betriebsbuch").Unprotect
'Bereich kopieren
Sheets("Protokoll").Range("L18:U29").Copy
'einfügen in erste freie Zeile in Betriebsbuch
Sheets("Betriebsbuch").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'Kopiermodus beenden
Application.CutCopyMode = False
Worksheets("Protokoll").Protect
Worksheets("Ausfüllhilfe").Activate
' Drucken / per Mail
'**Szenario 1 = Kein Material entstanden, dann per Mail an ?
If Range("H43") = 0 Then
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim strSubjectText As String
If Range("H4") = "Verwaltet!" Then
MsgBox "SENSIBEL"
Else
Worksheets("Ausfüllhilfe").Activate
Sheets("Ausfüllhilfe").Unprotect
Range("H4") = "Verwaltet!"
Sheets("Ausfüllhilfe").Protect
Worksheets("Protokoll").Activate
Sheets("Protokoll").Unprotect
Range("A37") = "XYXY versendet durch" & Range("H47").Value
'** Einfärbung der Zellen B1
If Range("B21") = "" And Range("C21") = "" Then
Range("B20:C21").Interior.Color = vbBlack
ElseIf Range("B21") = "x" Then
Range("C20:C21").Interior.Color = vbBlack
ElseIf Range("C21") = "x" Then
Range("B20:B21").Interior.Color = vbBlack
'** Einfärbung Zellen B2
If Range("D21") = "" And Range("C21") = "" Then
Range("D20:E21").Interior.Color = vbBlack
ElseIf Range("D21") = "x" Then
Range("E20:E21").Interior.Color = vbBlack
ElseIf Range("E21") = "x" Then
Range("D20:D21").Interior.Color = vbBlack
'** Einfärben Zellen B3
If Range("F21") = "" And Range("C21") = "" Then
Range("F20:G21").Interior.Color = vbBlack
ElseIf Range("F21") = "x" Then
Range("G20:G21").Interior.Color = vbBlack
ElseIf Range("G21") = "x" Then
Range("F20:F21").Interior.Color = vbBlack
'** Einfärben Zellen B4
If Range("H21") = "" And Range("C21") = "" Then
Range("H20:I21").Interior.Color = vbBlack
ElseIf Range("H21") = "x" Then
Range("I20:I21").Interior.Color = vbBlack
ElseIf Range("I21") = "x" Then
Range("H20:H21").Interior.Color = vbBlack
End If
Worksheets("BeSi Protokoll").Protect
'** Versenden per Mail
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
'** Betreff-Text festlegen
strSubjectText = "Negativprotokoll " & Range("B11").Value
'** Nachrichten-Text festlegen
strBodyText = "

" & "Sehr geehrte Damen und Herren,
" & _ "BLABLABLA.
" & _ "Mit freundlichen Grüßen.
" & _ "gez. " & Range("B18").Value & "
" & _ Range("A42").Value & "

" '** Mail erzeugen With Mail .To = "SENSIBEL" 'Empfänger .CC = Range("A43") 'Kopie an Empfänger .Subject = strSubjectText 'Betreff .BodyFormat = 2 '2 = HTML, 1 = Text .Attachments.Add strDatei 'Anhang .HTMLBody = strBodyText & strSignature End With '** Erzeugte Datei schließen Workbooks(Dir(strDatei)).Close '** Erzeugte Datei wieder löschen Kill (strDatei) Worksheets("Protokoll").Visible = False Worksheets("Ausfüllhilfe").Activate '** E-Mail anzeigen Mail.Display 'Abspeichern Worksheets("Ausfüllhilfe").Activate If Dir(Range("B56"), vbDirectory) = "" Then MkDir (Range("B57")) End If If Dir(Range("B58"), vbDirectory) = "" Then MkDir (Range("B59")) End If Worksheets("Protokoll").Activate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Range("H61"), Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ True Exit Sub End If '**Szenario 2= Material entstanden, dann ausdrucken und per Mail ? Else Worksheets("Ausfüllhilfe").Activate Sheets("Ausfüllhilfe").Unprotect Range("H4") = "Verwaltet!" Sheets("Ausfüllhilfe").Protect Worksheets("Protokoll").Activate Sheets("Protokoll").Unprotect Range("A37") = "BLABLABLA" & Range("H47").Value '** Einfärbung der Zellen B 1 If Range("B21") = "" And Range("C21") = "" Then Range("B20:C21").Interior.Color = vbBlack ElseIf Range("B21") = "x" Then Range("C20:C21").Interior.Color = vbBlack ElseIf Range("C21") = "x" Then Range("B20:B21").Interior.Color = vbBlack '** Einfärbung Zellen B 2 If Range("D21") = "" And Range("C21") = "" Then Range("D20:E21").Interior.Color = vbBlack ElseIf Range("D21") = "x" Then Range("E20:E21").Interior.Color = vbBlack ElseIf Range("E21") = "x" Then Range("D20:D21").Interior.Color = vbBlack '** Einfärben Zellen B3 If Range("F21") = "" And Range("C21") = "" Then Range("F20:G21").Interior.Color = vbBlack ElseIf Range("F21") = "x" Then Range("G20:G21").Interior.Color = vbBlack ElseIf Range("G21") = "x" Then Range("F20:F21").Interior.Color = vbBlack '** Einfärben Zellen B 4 If Range("H21") = "" And Range("C21") = "" Then Range("H20:I21").Interior.Color = vbBlack ElseIf Range("H21") = "x" Then Range("I20:I21").Interior.Color = vbBlack ElseIf Range("I21") = "x" Then Range("H20:H21").Interior.Color = vbBlack Worksheets("Protokoll").Protect End If '** Das aktive Tabellenblatt wird über Outlook versendet '** Dimensionierung der Variablen Worksheets("Protokoll").Activate Set outObj = CreateObject("Outlook.Application") Set Mail = outObj.CreateItem(0) '** Pfad für temporäre Zwischenspeicherung angeben strPfad = "C:\Temp" 'entsprechend anpassen '** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren strBlatt = ActiveSheet.Name '** Gewähltes Tabellenblatt kopieren Sheets(strBlatt).Copy '** Blatt temporär in vorgegebenes Verzeichnis abspeichern ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled '** Pfad und Dateiname der neuen Datei zwischenspeichern strDatei = ActiveWorkbook.FullName '** Betreff-Text festlegen strSubjectText = "? " & Range("B11").Value '** Nachrichten-Text festlegen strBodyText = "

" & "Sehr geehrte Damen und Herren,
" & _ "anbei übersende ich Ihnen BLABLALBA
" & _ "Mit freundlichen Grüßen.
" & _ "gez. " & Range("B18").Value & "
" & _ Range("A42").Value & "

" '** Mail erzeugen With Mail .To = Range("A43") 'Empfänger .Subject = strSubjectText 'Betreff .BodyFormat = 2 '2 = HTML, 1 = Text .Attachments.Add strDatei 'Anhang .HTMLBody = strBodyText & strSignature End With '** Erzeugte Datei schließen Workbooks(Dir(strDatei)).Close '** Erzeugte Datei wieder löschen Kill (strDatei) '** E-Mail anzeigen Mail.Display '** Datei drucken per Druckerauswahl Dim strPrinterName As String Dim varRueckgabe As Variant strPrinterName = Application.ActivePrinter varRueckgabe = Application.Dialogs(xlDialogPrinterSetup).Show If varRueckgabe = "Falsch" Then Exit Sub End If ActiveSheet.PrintOut Application.ActivePrinter = strPrinterName Worksheets("Protokoll").Visible = False Worksheets("Ausfüllhilfe").Activate ' Abspeichern If Dir(Range("B56"), vbDirectory) = "" Then MkDir (Range("B57")) End If If Dir(Range("B58"), vbDirectory) = "" Then MkDir (Range("B59")) End If Worksheets("Protokoll").Activate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Range("H61"), Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ True Exit Sub End If End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: If ohne End If Block
10.05.2021 19:08:59
Hajo_Zi
arbeite mit Einrückungen, dann fällt de Fehler auf.

Option Explicit
Sub BesiProtokoll_verwalten()
' 1. Verwalten und in das Betriebsbuch übertragen
Worksheets("Protokoll").Visible = True
Worksheets("Protokoll").Activate
Worksheets("Protokoll").Unprotect
Worksheets("Betriebsbuch").Unprotect
'Bereich kopieren
Sheets("Protokoll").Range("L18:U29").Copy
'einfügen in erste freie Zeile in Betriebsbuch
Sheets("Betriebsbuch").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'Kopiermodus beenden
Application.CutCopyMode = False
Worksheets("Protokoll").Protect
Worksheets("Ausfüllhilfe").Activate
' Drucken / per Mail
'**Szenario 1 = Kein Material entstanden, dann per Mail an ?
If Range("H43") = 0 Then
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim strSubjectText As String
If Range("H4") = "Verwaltet!" Then
MsgBox "SENSIBEL"
Else
Worksheets("Ausfüllhilfe").Activate
Sheets("Ausfüllhilfe").Unprotect
Range("H4") = "Verwaltet!"
Sheets("Ausfüllhilfe").Protect
Worksheets("Protokoll").Activate
Sheets("Protokoll").Unprotect
Range("A37") = "XYXY versendet durch" & Range("H47").Value
'** Einfärbung der Zellen B1
If Range("B21") = "" And Range("C21") = "" Then
Range("B20:C21").Interior.Color = vbBlack
ElseIf Range("B21") = "x" Then
Range("C20:C21").Interior.Color = vbBlack
ElseIf Range("C21") = "x" Then
Range("B20:B21").Interior.Color = vbBlack
'** Einfärbung Zellen B2
If Range("D21") = "" And Range("C21") = "" Then
Range("D20:E21").Interior.Color = vbBlack
ElseIf Range("D21") = "x" Then
Range("E20:E21").Interior.Color = vbBlack
ElseIf Range("E21") = "x" Then
Range("D20:D21").Interior.Color = vbBlack
'** Einfärben Zellen B3
If Range("F21") = "" And Range("C21") = "" Then
Range("F20:G21").Interior.Color = vbBlack
ElseIf Range("F21") = "x" Then
Range("G20:G21").Interior.Color = vbBlack
ElseIf Range("G21") = "x" Then
Range("F20:F21").Interior.Color = vbBlack
'** Einfärben Zellen B4
If Range("H21") = "" And Range("C21") = "" Then
Range("H20:I21").Interior.Color = vbBlack
ElseIf Range("H21") = "x" Then
Range("I20:I21").Interior.Color = vbBlack
ElseIf Range("I21") = "x" Then
Range("H20:H21").Interior.Color = vbBlack
End If
Worksheets("BeSi Protokoll").Protect
'** Versenden per Mail
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
'** Betreff-Text festlegen
strSubjectText = "Negativprotokoll " & Range("B11").Value
'** Nachrichten-Text festlegen
strBodyText = ""
" & "Sehr geehrte Damen und Herren,
" & _
"BLABLABLA.
" & _
"Mit freundlichen Grüßen.
" & _
"gez. " & Range("B18").Value & "
" & _
Range("A42").Value & "
'** Mail erzeugen
With Mail
.To = "SENSIBEL" 'Empfänger
.CC = Range("A43") 'Kopie an Empfänger
.Subject = strSubjectText 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.HTMLBody = strBodyText & strSignature
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
Worksheets("Protokoll").Visible = False
Worksheets("Ausfüllhilfe").Activate
'** E-Mail anzeigen
Mail.Display
'Abspeichern
Worksheets("Ausfüllhilfe").Activate
If Dir(Range("B56"), vbDirectory) = "" Then
MkDir (Range("B57"))
End If
If Dir(Range("B58"), vbDirectory) = "" Then
MkDir (Range("B59"))
End If
Worksheets("Protokoll").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Range("H61"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Exit Sub
End If
'**Szenario 2= Material entstanden, dann ausdrucken und per Mail ?
Else
Worksheets("Ausfüllhilfe").Activate
Sheets("Ausfüllhilfe").Unprotect
Range("H4") = "Verwaltet!"
Sheets("Ausfüllhilfe").Protect
Worksheets("Protokoll").Activate
Sheets("Protokoll").Unprotect
Range("A37") = "BLABLABLA" & Range("H47").Value
'** Einfärbung der Zellen B 1
If Range("B21") = "" And Range("C21") = "" Then
Range("B20:C21").Interior.Color = vbBlack
ElseIf Range("B21") = "x" Then
Range("C20:C21").Interior.Color = vbBlack
ElseIf Range("C21") = "x" Then
Range("B20:B21").Interior.Color = vbBlack
'** Einfärbung Zellen B 2
If Range("D21") = "" And Range("C21") = "" Then
Range("D20:E21").Interior.Color = vbBlack
ElseIf Range("D21") = "x" Then
Range("E20:E21").Interior.Color = vbBlack
ElseIf Range("E21") = "x" Then
Range("D20:D21").Interior.Color = vbBlack
'** Einfärben Zellen B3
If Range("F21") = "" And Range("C21") = "" Then
Range("F20:G21").Interior.Color = vbBlack
ElseIf Range("F21") = "x" Then
Range("G20:G21").Interior.Color = vbBlack
ElseIf Range("G21") = "x" Then
Range("F20:F21").Interior.Color = vbBlack
'** Einfärben Zellen B 4
If Range("H21") = "" And Range("C21") = "" Then
Range("H20:I21").Interior.Color = vbBlack
ElseIf Range("H21") = "x" Then
Range("I20:I21").Interior.Color = vbBlack
ElseIf Range("I21") = "x" Then
Range("H20:H21").Interior.Color = vbBlack
Worksheets("Protokoll").Protect
End If
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Worksheets("Protokoll").Activate
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
'** Betreff-Text festlegen
strSubjectText = "? " & Range("B11").Value
'** Nachrichten-Text festlegen
strBodyText = ""
" & "Sehr geehrte Damen und Herren,
" & _
"anbei übersende ich Ihnen BLABLALBA
" & _
"Mit freundlichen Grüßen.
" & _
"gez. " & Range("B18").Value & "
" & _
Range("A42").Value & "
'** Mail erzeugen
With Mail
.To = Range("A43") 'Empfänger
.Subject = strSubjectText 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.HTMLBody = strBodyText & strSignature
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
'** E-Mail anzeigen
Mail.Display
'** Datei drucken per Druckerauswahl
Dim strPrinterName As String
Dim varRueckgabe As Variant
strPrinterName = Application.ActivePrinter
varRueckgabe = Application.Dialogs(xlDialogPrinterSetup).Show
If varRueckgabe = "Falsch" Then
Exit Sub
End If
ActiveSheet.PrintOut
Application.ActivePrinter = strPrinterName
Worksheets("Protokoll").Visible = False
Worksheets("Ausfüllhilfe").Activate
' Abspeichern
If Dir(Range("B56"), vbDirectory) = "" Then
MkDir (Range("B57"))
End If
If Dir(Range("B58"), vbDirectory) = "" Then
MkDir (Range("B59"))
End If
Worksheets("Protokoll").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Range("H61"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Exit Sub
End If
End Sub
GrußformelHomepage
Anzeige
AW: If ohne End If Block
10.05.2021 19:57:41
MarcoH
Hallo Hajo,
Danke für die schnelle Rückmeldung!!
Ich habe deinen Code aus dem Zitat kopiert und eingefügt.
Trotz allem bringt er noch den gleichen Fehler. Wieder markiert er

Sub Besi Protokoll und das End 

Sub am Ende.
Ich komme irgendwie nicht weiter.... Tut mir leid...
LG Marco

AW: If ohne End If Block
10.05.2021 20:03:50
Hajo_Zi
ich habe nur Deine Code eingerückt und die fehlendcen End If nicht ergänzt. Dir ist klar von wo bis wo das if geht.
Ich arbeite da nicht ein.
Gruß Hajo
Anzeige
AW: If ohne End If Block
10.05.2021 20:15:13
MarcoH
Ah jetzt verstanden. Sorry, danke für die schnelle Hilfe 😊
LG Marco
AW: If ohne End If Block
10.05.2021 19:50:34
Sigi.21
Hallo,
Hajo hat vollkommen Recht.
Ich sehe 15 mal "If" aber nur 9 mal "End If".
Gruß
Sigi

271 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige