Elk werkblad afzonderlijk opslaan in PDF

[safe]

Hallo,

Ik probeer met mijn excelbestand het volgende te realiseren :

Als ik een excel sheet/blad dmv macro opsla, dan wordt deze als apart werkblad opgeslagen onder de naam dat in een cel B15 staat. Door deze handelingen heb ik een tig aan werkbladen in hetzelfde bestand.

Ik wil graag dmv een macro de werkbladen (vanaf blad 19) opslaan als afzonderlijke pdf-bestanden met de naam uit cel B15. De werkbladen moeten ook nog eens gescheiden worden in 3 verschillende mappen.

Bijv : Werkblad "Opdracht1" moet opgeslagen worden als Opdracht1.pdf in de map : c:\verkenningen\Hoog\Opdracht1.pdf

Werkblad "Opdracht2" Moet opgeslagen worden als Opdracht2.pdf in de map : c:\Metingen\Visueel\Opdracht2

Om deze sheets alvast hierop voor te bereiden dacht ik dat het misschien wel mogelijk is om de "nog in te vullen werkbladen" alvast te voorzien van deze informatie in een cel. Bijv. Cel E1 : c:\Metingen\Visueel\
en in cel E2 een formule plaatsen : =E1&B15


In vba wil ik dan een knop dat van te voren controleert of deze mappen en bestanden reeds bestaan, zo niet dan deze mappen ook automatisch aanmaakt en de pdf bestanden maakt vanaf sheet 19 tot aan de laatste(elke dag komen er sheets bij) , waar de macro zijn informatie uit cel E2 haalt van de betreffende sheet.

Deze knop wil ik graag omdat deze gegevens steeds worden uitgewisseld en op andere computers worden gezet.

Ik heb hier een voorbeeldje voor de beeldvorming :Bekijk bijlage Test document.xlsm

Ik werk met Excel 2010, en heb alleen wat basiskennis van vba.

Wie kan mij hierin helpen?

Alvast bedankt!!!

M.vr.gr.
Safe

 

[safe]

Ik heb inmiddels na lang zoeken een macro gevonden om dit (bijna) uit te voeren, maar het lukt mij niet om de macro vanaf tabblad 4 tot aan het laatste tabblad te laten herhalen.

Wat en waar moet ik nog iets toevoegen om deze functie dat te laten doen?

Alvast bedankt !!
M.vr.gr.
Safe

Option Explicit
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim aStr As String
Dim sPath As String
Dim FName As String
Const sStr As String = "C:\Project\"
Const sStr2 = "\Uitslagen\2.Draft Trades.xls"

Set WB = ThisWorkbook
Set SH = ActiveSheet
Set Rng = SH.Range("A1") '<<==== CHANGE

If Not IsEmpty(Rng.Value) Then
aStr = Rng.Value
FName = sStr & aStr & sStr2
ThisWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlWorkbookNormal
Else
'Your code to handle misssing data, e.g.:
MsgBox Prompt:="Your message", _
Buttons:=vbCritical, _
Title:="Problem"
  
End If


End Sub

 

[jolivanes]

Dim i As Long
For i = 4 to Sheets.Count
With Sheets(i)

'jou code

End With
Next i
End Sub

 

[safe]

Enorm bedankt jolivanes !!!

Daarmee kwam ik inderdaad (met wat kleine aanpassingen) tot de oplossing !!

Code is uiteindelijk als volgt geworden om elk werkblad vanaf werkblad 4 als een pdf op te slaan in een toegewezen submap (cel A1) met toegewezen naam (cel B1):

Option Explicit
Public Sub Tester()
Dim i As Long
For i = 4 To Sheets.Count
With Sheets(i)

Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim aStr As String
Dim sPath As String
Dim FName As String


Const sStr As String = "C:\Project\"
Const sStr1 As String = "\Uitslagen\"
Const sStr2 = ".pdf"
Set WB = ThisWorkbook
Set SH = Sheets(i)
Set Rng = SH.Range("A1") 
Set Rng1 = SH.Range("B1")
If Not IsEmpty(Rng.Value) Then
aStr = Rng.Value
bStr = Rng1.Value
FName = sStr & aStr & sStr1 & bStr & sStr2
ThisWorkbook.SaveAs FileName:=FName, _
FileFormat:=xlWorkbookNormal
Else
'Your code to handle misssing data, e.g.:
MsgBox Prompt:="A1 of B1 is leeg", _
Buttons:=vbCritical, _
Title:="Problem"

End If
End With
Next i
End Sub

Nogmaals bedankt !! :thumb:

M.vr.gr.
Safe

 

[Warme bakkertje]

Is dat misschien iets nieuws in XL2010 dat je door gewoon ".pdf" achter de naam te zetten je een werkblad daadwerkelijk als een echt PDF-bestand opslaat ?????
Al eens geprobeerd om het bestand dan in Acrobat Reader te openen ???

 

[safe]

OOwwww... Warme Bakkertje, je hebt inderdaad gelijk...
Tot zover had ik niet getest..Erg stom van me, maar nu weet ik niet hoe ik dit naar een pdf kan omzetten.

Ik had het al geprobeerd met "xlTypePDF" maar dan krijg ik een foutmelding "400"..(??)
Ook geprobeerd met een stukje erbij

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
Bestand, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

Ook helaas niet het gewenste effect...
Tot zo ver gaat mijn kennis hierover..

Wat zou ik anders hieraan moeten veranderen?

(Bedankt voor je scherpe blik!!!!!)

M.vr.gr.
Safe

 

[robdgr]

Ik pas zelf de volgende regel toe:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\<naam>\Desktop\Ledenlijst " & [jaar].Value & " Fotoclub " & " - versie " & Format(Now(), "dd-mm-yy") & " " _
        & Format(Hour(Now()), "00") & Format(Minute(Now()), "00") & ".pdf", Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

en dit werkt perfect.

 

[safe]

Beste Robdgr,

bedankt voor je reactie.
Deze code heb ik geprobeerd maar helaas lukt het mij niet om dit werkend te krijgen.
Waarschijnlijk dat het iets te maken heeft met het eerste deel van je macro dat begint met "ActiveSheet"
Dit heb ik naar diverse opties verandert, maar helaas zonder succes..

Alsnog bedankt voor het meedenken!!

Hierdoor heb ik mijn macro nog niet werkend gekregen.

Zijn er nog ideeën?

M.vr.gr.
Safe

 

[Jack Nouws]

kijk eens naar deze topic http://www.helpmij.nl/forum/showthread.php/668553-Automatisch-PDF-opslaan-in-excel

 

[Warme bakkertje]

Option Explicit

Sub tester()
Dim i As Long, fName As String, foutmelding As String
For i = 4 To Sheets.Count
    With Sheets(i)
        If .Range("A1") = vbNullString Or .Range("B1") = vbNullString Then foutmelding = _
                foutmelding & vbLf & Sheets(i).Name: GoTo vervolg
        fName = "C:\Project\" & .Range("A1") & "\Uitslagen\" & .Range("B1")
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName & ".pdf", Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
vervolg:
Next
If foutmelding <> "" Then MsgBox "Volgend(e) werkblad(en) zijn niet opgeslagen" & vbLf & _
        "wegens onvoldoende parameters !" & foutmelding
End Sub

 

[safe]

Bedankt Warme Bakkertje voor je code.

Helaas krijg ik nog de volgende foutmelding in beeld :

compileerfout: sub of function is niet gedefinieerd

(Het woord "vervolg" onderaan de macro wordt blauw geaccentueerd)

Wat moet ik aanpassen om dit te voorkomen?

M.vr.gr.
Safe.

 

[Warme bakkertje]

Oeps, vergetelheidje
Er moet nog een dubbele punt achter vervolg onderaan de macro.
Mijn oprechte excuses hiervoor.

 

[safe]

TOP !!!
De functie werkt naar behoren.

Warme Bakkertje enorm bedankt voor je hulp !!
Ben ik erg blij mee !!

M.vr.gr.
Safe