Makro wiederholen bis Zelle leer

Forumthread: Makro wiederholen bis Zelle leer

18.05.2017 14:45:16

Ralf

Hallo zusammen,
ich habe ein Makro zusammengestellt, welches automatisch eine E-Mail öffnet und einen Anhang als PDF einfügt. Der Empfänger und der Anhang wird aus der ersten Zeile des Tabellenblatts "Zusammenfassung" übernommen. Soweit funktioniert auch alles einwandfrei.
Dieses Makro müsste jetzt mit den Daten der 2. Zeile 3. Zeile usw. bis eine leere Zeile kommt durchgeführt werden. Leider fehlen mit hier die Kenntnisse wie und ob so etwas möglich ist.
Grüße Ralf

Sub Abrechnung_versenden()
Dim mePDFD As String
Dim MyOutApp As Object, MyMessage As Object
Sheets(Array(Sheets("Zusammenfassung").Range("a1").Value)).Copy
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung").Range("f1"). _
_
Value & " " & Date & ".pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
:=False
mePDFD = ThisWorkbook.Path & "\" & Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung"). _
Range("f1").Value & " " & Date & ".pdf"
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung").Range("e1").Value
.Subject = "Maßnahme " & Date
.body = "Hallo "
.Attachments.Add mePDFD
.Display
Kill mePDFD
End With
ActiveWorkbook.Close False
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro wiederholen bis Zelle leer

18.05.2017 15:01:27

ChrisL

Hi
Ungetestet...

Sub t()
dim i as long
for i = 1 to cells(rows.count, 1).end(xlup).row
Call Abrechnung_versenden(i)
next i
End Sub


Private Sub Abrechnung_versenden(Zeile As Long)
Dim mePDFD As String
Dim MyOutApp As Object, MyMessage As Object
Sheets(Array(Sheets("Zusammenfassung").Range("a" & Zeile).Value)).Copy
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & _
Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung").Range("f" & Zeile). _
_
Value & " " & Date & ".pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
:=False
mePDFD = ThisWorkbook.Path & "\" & Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung"). _
Range("f" & Zeile).Value & " " & Date & ".pdf"
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung").Range("e" & Zeile _
).Value
.Subject = "Maßnahme " & Date
.body = "Hallo "
.Attachments.Add mePDFD
.Display
Kill mePDFD
End With
ActiveWorkbook.Close False
End Sub

cu
Chris

AW: Makro wiederholen bis Zelle leer

18.05.2017 15:06:30

UweD

Hallo
auch ungetestet...

Sub Abrechnung_versenden()

    Dim mePDFD As String, LR As Double, i As Double
    Dim MyOutApp As Object, MyMessage As Object
    LR = Sheets("Zusammenfassung").Cells(Sheets("Zusammenfassung").Rows.Count, "A").End(xlUp).Row
    For i = 1 To LR
        Sheets(Array(Sheets("Zusammenfassung").Range("a" & i).Value)).Copy
        mePDFD = ThisWorkbook.Path & "\" & Workbooks("Statusbericht.xlsm"). _
            Sheets("Zusammenfassung").Range("f" & i).Value & " " & Date & ".pdf"
    
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    
        Set MyOutApp = CreateObject("Outlook.Application")
        Set MyMessage = MyOutApp.CreateItem(0)
        With MyMessage
            .To = Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung") _
                .Range("e" & i).Value
            .Subject = "Maßnahme " & Date
            .body = "Hallo "
            .Attachments.Add mePDFD
            .Display
            
           Kill mePDFD
        
        End With
    Next i
    ActiveWorkbook.Close False
End Sub

LG UweD

AW: Makro wiederholen bis Zelle leer

19.05.2017 07:38:27

Ralf

Vielen Dank für die schnelle Unterstützung, habe den Code von Uwe noch minimal geändert. In der zweiten Runde bricht er immer mit Laufzeitfehler ab. Er geht auch in das richtige Tabellenblatt und bricht vor dem umwandeln in eine PDF ab. Dieser Bereich ist dann gelb markiert:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Ich habe den Code von Uwe genommen, der sieht jetzt so aus:

Sub Abrechnung_versenden2()
Dim mePDFD As String, LR As Double, i As Double
Dim MyOutApp As Object, MyMessage As Object
LR = Sheets("Zusammenfassung").Cells(Sheets("Zusammenfassung").Rows.Count, "A").End(xlUp). _
Row
For i = 2 To LR
Sheets(Array(Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung").Range("a" & i). _
Value)).Select
mePDFD = ThisWorkbook.Path & "\" & Workbooks("Statusbericht.xlsm"). _
Sheets("Zusammenfassung").Range("f" & i).Value & " " & Date & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Workbooks("Statusbericht.xlsm").Sheets("Zusammenfassung") _
.Range("e" & i).Value
.Subject = "Maßnahme " & Date
.body = "Hallo "
.Attachments.Add mePDFD
.Display
Kill mePDFD
End With
Next i
End Sub

AW: Makro wiederholen bis Zelle leer

19.05.2017 09:23:24

Ralf

Klappt alles, lag an dem Text der aus den Zellen übernommen wird, kam mit "/" nicht klar. Grüße Ralf

AW: Makro wiederholen bis Zelle leer

19.05.2017 09:38:45

Ralf

Gibt es noch die Möglichkeit am Beginn des Makros die Zellen auszuwählen, für die das Makro jeweils durchgeführt werden soll? z.B. B-F und H.
Grüße
Ralf

AW: Makro wiederholen bis Zelle leer

19.05.2017 09:57:50

ChrisL

hi Ralf
Falls es darum geht die Spalten variabel zu gestalten.
Range("A" & Zeile)
entspricht
Cells(Zeile, 1)
resp.
Cells(Zeile, Variable)
cu
Chris

AW: Makro wiederholen bis Zelle leer

19.05.2017 10:44:08

UweD

Hallo
das kann ich nicht nachvollziehen
Im Makro wird gleichzeitig Spalte A, F und E verwendet.
Welche Spalten willst du vorher auswählen und welche Spalten sollen dann im Makro abgearbeitet werden?
LG UweD

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro wiederholen bis Zelle leer

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Makro wiederholen bis Zelle leer

Forumthread: Makro wiederholen bis Zelle leer

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread