Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1556to1560
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

Makro wiederholen bis Zelle leer

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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

Anzeige
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
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige