Microsoft Excel

Herbers Excel/VBA-Archiv

Daten kopieren und daraus Pdf erzeugen


Betrifft: Daten kopieren und daraus Pdf erzeugen von: Sebastian Lauenstein
Geschrieben am: 23.01.2019 17:59:59

Hallo Forum,

Ich habe zwei Tabellen Blätter
1 (Daten) Namen und Stunden sowie deren Arbeitszeiten, diese Daten möchte ich wenn im Tabellenblatt (Daten) Spalte 1 ein X steht ins Tabellenblatt (Sheet) kopieren je Mitarbeiter und daraus dann ein PDF erzeugen mit "Montagenachweis""Name""Kalenderwoche"
Gibt es da eine möglichkeit mit VBA dies zu realisieren?
unten Angehängt das Formular

https://www.herber.de/bbs/user/127039.xlsm

  

Betrifft: AW: Daten kopieren und daraus Pdf erzeugen von: onur
Geschrieben am: 23.01.2019 18:52:29

JA, aber das ist etwas zu viel verlangt für ein Forum, wo du Hilfe bei kleineren Problemen bekommen kannst.
Du wilst aber eine Komplettlösung - Dafür gibt es Auftragsprogrammierer.
Vielleicht erbarmt sich ja mal Jemand doch.


  

Betrifft: Das stimmt so nicht ganz und ich... von: robert
Geschrieben am: 23.01.2019 19:11:09

hätte gerne für jede Komplettlösung hier im Forum einen Euro :)

Frage ist noch : was ist eine "Komplettlösung" ?

Gruß
robert


  

Betrifft: AW: Das stimmt so nicht ganz und ich... von: onur
Geschrieben am: 23.01.2019 19:12:49

Hast du dir die Datei angesehen (was alles auf Blatt 2 ausgefüllt werden muss)?


  

Betrifft: Na Servus...Du hast Recht ;-) owT und Gruß von: robert
Geschrieben am: 23.01.2019 19:40:18




  

Betrifft: AW: Daten kopieren und daraus Pdf erzeugen von: JoWE
Geschrieben am: 23.01.2019 19:59:24

Hallo Sebastian,

ich hab's trotz der von Onur richtigerweise erwähnten Problematik mal probiert.
Allerdings sind in Deiner Namenspalte (Tabelle Daten) mal Kommata und mal nicht.
Mein Code verlangt jedoch zwischen Name und Vorname ein Komma!!! Z.B. "Gosparic, Daniel".

Sub makeDocuments_to_pdf()
    Dim ze As Long
    Dim i As Long
    Dim myPath As String
    Dim myFName As String
    With Sheets("Daten")
        For ze = 10 To .Cells(Rows.Count, 2).End(xlUp).Row
            If .Cells(ze, 1) = "x" Then
                For i = 10 To 16
                    Sheets("Sheet").Cells(i, 3) = .Cells(ze, 3)
                    Sheets("Sheet").Cells(i, 4) = .Cells(ze, 4)
                Next
            End If
            myPath = ThisWorkbook.Path & "\" 'Speicherpfad evtl. anpassen
            myFName = "Montagenachweis " & UCase(Mid(.Cells(ze, 2), _
             InStr(1, .Cells(ze, 2), ",") + 2, 99)) & " KW " & .Cells(1, 3) & ".pdf"
            myFName = myPath & myFName
            Sheets("Sheet").ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFName, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, OpenAfterPublish:=False
        Next
     End With
End Sub

Gruß
Jochen


  

Betrifft: AW: habe noch was korrigiert.... von: JoWE
Geschrieben am: 23.01.2019 20:18:06

...sieh' es als Einstieg, den Rest der Zieltabelle solltest Du selbst erarbeiten können!?

Sub makeDocuments_to_pdf()
    Dim ze As Long
    Dim i As Long
    Dim sp As Long
    Dim myPath As String
    Dim myFName As String
    With Sheets("Daten")
        For ze = 10 To .Cells(Rows.Count, 2).End(xlUp).Row
            If .Cells(ze, 1) = "x" Then
                sp = 3
                For i = 10 To 16
                    Sheets("Sheet").Cells(i, 3) = .Cells(ze, sp)
                    Sheets("Sheet").Cells(i, 4) = .Cells(ze, sp + 1)
                    sp = sp + 3
                Next
            End If
            myPath = ThisWorkbook.Path & "\" 'Speicherpfad evtl. anpassen
            myFName = "Montagenachweis " & UCase(Mid(.Cells(ze, 2), _
             InStr(1, .Cells(ze, 2), ",") + 2, 99)) & " KW " & .Cells(1, 3) & ".pdf"
            myFName = myPath & myFName
            Sheets("Sheet").ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFName, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, OpenAfterPublish:=False
        Next
     End With
End Sub



  

Betrifft: AW: habe noch was korrigiert.... von: Sebastian Lauenstein
Geschrieben am: 24.01.2019 16:56:09

Danke für eure Hilfe so funktioniert es schon Ganz gut.
Habe Lediglich noch hinzugefügt das die Namen noch kopiert werden.

Gibt es noch eine Möglichkeit die Pdf anzupassen das die komplette a4 Seite Genutzt wird


  

Betrifft: AW: habe noch was korrigiert.... von: JoWE
Geschrieben am: 24.01.2019 17:49:10

… das kannst Du doch in der Tabelle Sheet über Seite einrichten anpassen.
Da muss also nichts extra per Code angepasst werden.
Z.B. Seitenlayout, Seite einrichten, verkleinern/vergrößern = 92%

Gruß
Jochen


  

Betrifft: AW: von: Sebastian Lauenstein
Geschrieben am: 24.01.2019 18:17:00

Ja Stimmt bin ich auf zwischenzeitlich drauf gekommen

Aber noch was anderes. Lasse das Script gerade mal Durchlaufen.
Dabei ist mir Aufgefallen das auch ein PDF erzeugt wird wo kein x eingetragen ist.
Option Explicit

Sub makeDocuments_to_pdf()
    Dim na As Long
    Dim n As Long
    Dim ze As Long
    Dim i As Long
    Dim sp As Long
    Dim myPath As String
    Dim myFName As String
    With Sheets("Daten")
        For ze = 10 To .Cells(Rows.Count, 2).End(xlUp).Row
            If .Cells(ze, 1) = "x" Then
               na = 2
               sp = 3
                For n = 4 To 4
                    Sheets("Sheet").Cells(n, 1) = .Cells(ze, na)
        Next
        End If
        
        If .Cells(ze, 1) = "x" Then
                sp = 3
                For i = 10 To 16
                    Sheets("Sheet").Cells(i, 3) = .Cells(ze, sp)
                    Sheets("Sheet").Cells(i, 4) = .Cells(ze, sp + 1)
                    sp = sp + 3
                Next
            End If
            myPath = ThisWorkbook.Path & "\Leistungsnachweise\" 'Speicherpfad evtl. anpassen
            myFName = "Montagenachweis " & UCase(Mid(.Cells(ze, 2), _
             InStr(1, .Cells(ze, 2), ",") + 2, 99)) & " KW " & .Cells(1, 3) & ".pdf"
            myFName = myPath & myFName
            Sheets("Sheet").ExportAsFixedFormat Type:=xlTypePDF, FileName:=myFName, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, OpenAfterPublish:=False
        Next
     End With
End Sub
https://www.herber.de/bbs/user/127077.xlsm


  

Betrifft: AW: ja, da ist was nicht ok... von: JoWE
Geschrieben am: 24.01.2019 18:43:48

...daher habe ich den Code nochmal leicht verändert. Der Teil, welcher pdf-Dateien erstellt,
muss natürlich innerhalb des If / end If -Bereiches stehen.
Ich habe Deine Änderung nicht eingebaut, das bekommst Du ja selbst wieder hin?!

Sub makeDocuments_to_pdf()
    Dim ze As Long
    Dim i As Long
    Dim sp As Long
    Dim myPath As String
    Dim myFName As String
    With Sheets("Daten")
        For ze = 10 To .Cells(Rows.Count, 2).End(xlUp).Row
            If .Cells(ze, 1) = "x" Then
                sp = 3
                Sheets("Sheet").Cells(4, 1) = Mid(.Cells(ze, 2), _
                  InStr(1, .Cells(ze, 2), ",") + 2, 99) & _
                  ", " & UCase(Left(.Cells(ze, 2), _
                  InStr(1, .Cells(ze, 2), ",") - 1))
                For i = 10 To 16
                    Sheets("Sheet").Cells(i, 3) = .Cells(ze, sp)
                    Sheets("Sheet").Cells(i, 4) = .Cells(ze, sp + 1)
                    sp = sp + 3
                Next
                myPath = ThisWorkbook.Path & "\" 'Speicherpfad evtl. anpassen
                myFName = "Montagenachweis " & UCase(Mid(.Cells(ze, 2), _
                 InStr(1, .Cells(ze, 2), ",") + 2, 99)) & " KW " & .Cells(1, 3) & ".pdf"
                myFName = myPath & myFName
                Sheets("Sheet").ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFName, _
                 Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                 IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        Next
     End With
End Sub
Gruß
Jochen


Beiträge aus dem Excel-Forum zum Thema "Daten kopieren und daraus Pdf erzeugen"