Office: (Office Version unbekannt) Auf Zellinhalte prüfen und dann 2 Makro ausführen

Hallo Zusammen

Ich möchte gerne ein VBA Code erstellen der bestimmte Zellen auf deren Inhalt prüft. Wenn die Zellen leer sind kommt eine Meldung welche Zellen noch ausgefüllt werden müssen und wenn die Zellen ausgefüllt sind, sollte es die Tabelle als PDF per Mail versenden.

Der Code für die Abfrage wie auch für das Mail funktionieren einzeln einwandfrei. Nur weis ich nicht wie ich diese zwei Makros zusammen bringen kann.

Code für die Abfrage:


Sub makro1()
If Range("E16").Value = "" Then
MsgBox "Datum fehlt", vbCritical, "Werte ausfüllen.."
End If

If Range("E18").Value = "" Then
MsgBox "Zeit bei Tankwechsel fehlt", vbCritical, "Werte ausfüllen.."
End If

If Range("E20").Value = "" Then
MsgBox "Zeit bei Dichtemessung fehlt", vbCritical, "Werte ausfüllen.."
End If

If Range("C24").Value = "" Then
MsgBox "von Tank (Tank-Nummer fehlt)", vbCritical, "Werte ausfüllen.."
End If

If Range("F24").Value = "" Then
MsgBox "nach Tank (Tank-Nummer fehlt)", vbCritical, "Werte ausfüllen.."
End If

If Range("H26").Value = "" Then
MsgBox "Dichte effektiv fehlt", vbCritical, "Werte ausfüllen.."
End If


If Range("H28").Value = "" Then
MsgBox "Temperatur fehlt", vbCritical, "Werte ausfüllen.."
End If

If Range("H33").Value = "" Then
MsgBox "Visum fehlt", vbCritical, "Werte ausfüllen.."
End If

If ActiveCell.Offset(0, 0) = "" Then
Exit Sub
Else

End If
End Sub


Code für das 2.Makro

Sub testmakro2()


Dim Mailadresse As String, Betreff As String
Dim olApp As Object

Set olApp = CreateObject("Outlook.Application")
Mailadresse = Verketten(Worksheets("Mailadresse").Range("H15:H18"))
Mailadresse1 = Verketten(Worksheets("Mailadresse").Range("H19:H22"))
Mailadresse2 = Verketten(Worksheets("Mailadresse").Range("H23:H24"))

Betreff = Verketten(Worksheets("tabelle1").Range("C51"))

Const DateiPfad = "\\*****\******\****\*****.xlsm"
Dim DateiName As String

DateiName = DateiPfad & Range("C51") & ".pdf" '

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
DateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

With olApp.CreateItem(0)
.To = Mailadresse
.CC = Mailadresse1
.BCC = Mailadresse2
.Subject = Betreff
.htmlBody = "Guten Morgen " & _
Range("C52").Value & ". " & _
"Freundliche Grüsse " & " " & _
Range("C59").Value & " " & _
Range("C60").Value & " " & _
Range("C61").Value & olOldBody ' Body. "" = Zeilenumbruchanweisung

.Attachments.Add DateiPfad & Range("C51") & ".pdf"
.Importance = 2
.Display
'.Send
Kill DateiPfad & Range("C51") & ".pdf"
End With
Set olApp = Nothing
End Sub



Function Verketten(rng As Range) As String
Dim strKette As String
Dim Zelle As Range

For Each Zelle In rng
strKette = strKette & "; " & Zelle.Text
Next Zelle

Verketten = VBA.Right(strKette, Len(strKette) - 2)
End Function


Könnt ihr mir helfen? Vielen Dank

lg Roli

 

Hallo Roli,

wo ist dein Problem?
Einfach eine Abfrage mit allen Deinen Zellen und da dein 2.Makro rein:

Code:

If Range("E16").Value <> "" and Range("E18").Value <> "" and ... Then
Call testmakro2
End if

Aber zwei Anmerkungen:
- lässt sich mit deinem Formular vor lauter MessageBoxen angenehm arbeiten? Du bekommst doch bestimmt nach der Eingabe des ersten Wertes 7 (!) Boxen angezeigt, die du alle bestätigen musst.
- Bei einem automatischen E-Mail-Versand musst Du dir schon sicher sein, was in der Datei steht. Ich würde davon abraten, die Datei nach dem Ausfüllen des letzten Feldes automatisch zu verschicken. Was machst Du, wenn sich jemand vertippt hat? Er hat keine Möglichkeit seinen Fehler zu korrigieren.

Vielleicht baust Du einen Button in dein Formular ein, der die Einträge auf Vollständigkeit prüft und dann die Datei verschickt.

Gruß,
Lutz

 

Hi,

Im Code des Fragestellers wird nicht automatisch versendet sondern nur Outlook mit dem jeweiligen Mailinhalt/Adresse geöffnet (.Display)

Bis später,
Karin

 

Hallo Karin,

Du hast ja recht, im Code steht's nicht, aber

Nur für den Fall, dass Roli das in Betracht zieht.

Gruß,
Lutz

 

Guten Morgen Lutz

Du hast recht, müsste ich dann den Code anders machen für die Abfrage? Das Ziel wäre schon, das die Einträge auf Vollständigkeit geprüft werden und wenn alle Zellen ausgefüllt sind das es die Datei verschickt.

Gruss Roli

 

Guten Morgen Lutz und Karin

Tut mir leid für die späte Meldung.Das stimmt, wie müsste ich dann den Code abändern? Mein Ziel wäre schon das die Einträge zuerst auf Vollständigkeit geprüft werden das man noch korrigieren kann. Wenn alle Felder ausgefüllt sind dann dürfte es die Datei erst zum versenden freigeben. Geht das auch nur mit einem Button?

Gruss Roli

 

Hallo Roli,

hab nochmal drüber nachgedacht, wie ich es machen würde.
Ich würde einen Button einbauen, der den E-Mail-Versand anstößt (Makro2 starten). Vor der Zeile Set olApp = CreateObject("Outlook.Application") das Makro1 aufrufen, damit die Einträge auf Vollständigkeit geprüft werden.
Dann kannst Du deine Abfrage auch so lassen, weil derjenige, der sich Mühe gibt, bekommt keine Meldung, und der Faule, bekommt massenweise Fensterchen angezeigt.
Trotzdem würde ich die möglichen Fehler nach und nach abarbeiten und die Fehlerhafte Zelle auswählen:

Code:

If Range("E16").Value = "" Then
MsgBox "Datum fehlt", vbCritical, "Werte ausfüllen.."
Range("E16").Select

Elseif Range("E18").Value = "" Then
MsgBox "Zeit bei Tankwechsel fehlt", vbCritical, "Werte ausfüllen.."
Range("E18").Select

usw....

End If

Gruß,
Lutz

 

Hallo Lutz

Es tut mit leid für die späte Benachrichtigung hatte Ferien.

Ich habe jetzt einen Button im Tabellenblatt eingebaut damit ich das Makro2 starten kann.
Vor der Zeile Set olApp = CreateObject("Outlook.Application")im makro2 habe zum aufrufen vom Makro1 "Call Makro1"
eingegeben.
Klappt leider so nicht ganz, das Makro2 läuft durch auch wenn die Zellen noch leer sind.

Sub testmakro2()


Dim Mailadresse As String, Betreff As String
Dim olApp As Object

Call Makro1

Set olApp = CreateObject("Outlook.Application")
Mailadresse = Verketten(Worksheets("Mailadresse").Range("H15:H18"))
Mailadresse1 = Verketten(Worksheets("Mailadresse").Range("H19:H22"))
Mailadresse2 = Verketten(Worksheets("Mailadresse").Range("H23:H24"))

Betreff = Verketten(Worksheets("tabelle1").Range("C51"))

Const DateiPfad = "\\*****\******\****\*****.xlsm"
Dim DateiName As String

DateiName = DateiPfad & Range("C51") & ".pdf" '

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
DateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

With olApp.CreateItem(0)
.To = Mailadresse
.CC = Mailadresse1
.BCC = Mailadresse2
.Subject = Betreff
.htmlBody = "Guten Morgen

" & _
Range("C52").Value & ".

" & _
"Freundliche Grüsse

" & "

" & _
Range("C59").Value & "
" & _
Range("C60").Value & "
" & _
Range("C61").Value & olOldBody ' Body. "
" = Zeilenumbruchanweisung

.Attachments.Add DateiPfad & Range("C51") & ".pdf"
.Importance = 2
.Display
'.Send
Kill DateiPfad & Range("C51") & ".pdf"
End With
Set olApp = Nothing
End Sub



Function Verketten(rng As Range) As String
Dim strKette As String
Dim Zelle As Range

For Each Zelle In rng
strKette = strKette & "; " & Zelle.Text
Next Zelle

Verketten = VBA.Right(strKette, Len(strKette) - 2)
End Function
Was habe ich falsch gemacht.

gruss Roli

 

Hallo Roli,

4 Wochen Ferien? Will ich auch!!!

Was passiert, wenn Du Makro1 direkt aufrufst? Funktioniert's?
Was passiert, wenn du Makro2 inkl. "Call Makro1" im Einzelschrittmodus laufen lässt?

Gruß,
Lutz

 

Hallo Lutz

Wenn ich das Makro1 direkt aufrufe, funktioniertes einwandfrei.
Wenn ich das Makro2 inkl. "Call Makro1" im Einzelschrittmodus laufen lasse, kommt die Meldung

Fehler beim Kompilieren:
Sub oder Function nicht definiert

keine Ahnung was ich jetzt machen muss.

Das mit dem Einzelschrittmodus kannte ich bis jetzt noch nicht. Darum hatte ich das auch nicht bemerkt.

Gruss Roli

 

Hallo Lutz

wenn ich das Makro1 direkt aufrufe funktioniert es.
wenn ich das Makro2 inkl. "Call Makro1" im Einzelschrittmodus laufen lasse, kommt die Meldung

Fehler beim Kompilieren:
Sub oder Function nicht definiert

Guter Tipp mit dem Einzelschrittmodus, kannte ich bis jetzt nicht, hab etwas dazu gelernt.
Leider weiss ich auch nicht was damit gemeint ist.

gruss Roli

 

Hallo Roli,

eigentlich solltest Du die Fehlermeldung auch im normalen Ablauf bekommen. Komisch...

Ist der Begriff Makro1 im Kopf von Makro1 und im Befehl in Makros 2 wirklich gleich geschrieben? Ich weiß nicht, ob Groß-/Kleinschreibung einen Einfluss hat.
Liegen beide Makros in der gleichen Mappe?

Gruß,
Lutz

 

Hallo Lutz

Du hast recht, "Call Makro1" gab es nicht. Ich musste "Call prüfen" reinschreiben.
Jetzt geht es auch im Einzelschrittmodus. Leider funktioniert es noch nicht so richtig.
Die Prüfung macht er zwar, aber wenn ich beim werteausfüllen "OK" drücke kommt direkt das Mail. Obwohl es noch leere Zellen hat.

Oder gibt es auch eine Variante wenn ich zum Beispiel in Zelle A1 den Wert 1 habe das er beim drücken des Butten das Makro1 ausführt und beim Wert 0 das Makro2?

Gruss Roli

 

Hallo Roli,

da hast Du recht... Mit Call prüfen ruft er das Makro auf und prüft. Anschließend bereitet er die Mail vor, unabhängig vom Ergebnis der Prüfung.

Ich hab da nochmal drauf rumgedacht.
Rufe doch einfach per Button das Makro prüfen auf und ergänze als letztes Else in der If-Abfrage Call Makro2. Ziel soll sein, das Du per Button-Click Deine Eingaben prüfst und nur wenn alles i.O. ist auch die Mail vorbereitest.

Einfach mal probieren und bei Fragen bitte den aktuellen Satnd der Makros posten.

Gruß,
Lutz

 

Hallo Lutz

Jetzt funktioniert es wie ich es mir vorgestellt habe. :D

Vielen lieben Dank für deine Unterstützung.

Anbei noch der Komplette Code:

Code:

Sub Prüfung_Tagesdichte()

    If Range("E16").Value = "" Then
        MsgBox "Datum fehlt", vbCritical, "Werte ausfüllen.."
        Range("E16").Select
       
          ElseIf Range("E18").Value = "" Then
          MsgBox "Zeit bei Tankwechsel fehlt", vbCritical, "Werte ausfüllen.."
        Range("E18").Select
        
            ElseIf Range("E20").Value = "" Then
            MsgBox "Zeit bei Dichtemessung fehlt", vbCritical, "Werte ausfüllen.."
            Range("E20").Select
            
             ElseIf Range("C24").Value = "" Then
               MsgBox "von Tank (Tank-Nummer fehlt)", vbCritical, "Werte ausfüllen.."
               Range("C24").Select
               
                  ElseIf Range("F24").Value = "" Then
                  MsgBox "nach Tank (Tank-Nummer fehlt)", vbCritical, "Werte ausfüllen.."
                   Range("F24").Select
                  
                    ElseIf Range("H26").Value = "" Then
                    MsgBox "Dichte effektiv fehlt", vbCritical, "Werte ausfüllen.."
                     Range("H26").Select
                    
                      ElseIf Range("H28").Value = "" Then
                      MsgBox "Temperatur fehlt", vbCritical, "Werte ausfüllen.."
                      Range("H28").Select
                      
                        ElseIf Range("H33").Value = "" Then
                        MsgBox "Visum fehlt", vbCritical, "Werte ausfüllen.."
                     Range("H33").Select
Else: Call Mail

End If
End Sub


 Sub Mail()
    Dim Mailadresse  As String, Betreff As String
     Dim olApp As Object
   
     Set olApp = CreateObject("Outlook.Application")
     Mailadresse = Verketten(Worksheets("Mailadresse").Range("H15:H18"))
     Mailadresse1 = Verketten(Worksheets("Mailadresse").Range("H19:H22"))
     Mailadresse2 = Verketten(Worksheets("Mailadresse").Range("H23:H24"))
     
     Betreff = Verketten(Worksheets("Tankwechsel").Range("C51"))
     
       Const DateiPfad = "\\TAR02\Home$\Dispo\Desktop\Pipelinemessung Tankwechsel2.xlsm"
     Dim DateiName As String
     
     DateiName = DateiPfad & Range("C51") & ".pdf"  '

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         DateiName, Quality:=xlQualityStandard, _
         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
         False
         
     With olApp.CreateItem(0)
         .To = Mailadresse
         .CC = Mailadresse1
         .BCC = Mailadresse2
         .Subject = Betreff
         .htmlBody = "Guten Morgen " & _
                          Range("C52").Value & ". " & _
          "Freundliche Grüsse " & " " & _
          Range("C59").Value & " " & _
          Range("C60").Value & " " & _
          Range("C61").Value & olOldBody ' Body. "" = Zeilenumbruchanweisung
         
         .Attachments.Add DateiPfad & Range("C51") & ".pdf"
         .Importance = 2
         .Display
         '.Send
      Kill DateiPfad & Range("C51") & ".pdf"
End With
     Set olApp = Nothing
      End Sub
      
 


Function Verketten(rng As Range) As String
 Dim strKette As String
 Dim Zelle As Range

 For Each Zelle In rng
     strKette = strKette & "; " & Zelle.Text
 Next Zelle

 Verketten = VBA.Right(strKette, Len(strKette) - 2)
 End Function
   

gruss Roli