Pdf printen op bep. dir. en oplopende nummering

[sylvietoin]

Hoi,

Ik wil een (volledig) werkblad d.m.v. een macro op pdf laten printen in een bep. dir. c:\ order \ documentenlijsten\
met de naam document- ***


Order: staat in cel Q4

steeds als ik een nieuwe print wil moet deze dan de naam document met een opeenvolgend nummer document(1) document(2) enz. krijgen.

Ben niet goed bekend met VBA maar heb al wel het een en ander geprobeerd.

Sub PDFprinten()
'
' PDFprinten Macro
'
'Deze routine print het werkblad laatste rev. als pdf onder C:\order\documentenlijsten\
'
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

'Find the path to "C:/7001/DOCUMENTENLIJSTEN"
Set oWSH = CreateObject("WScript.Shell")
sPath = "c:\" & Worksheets("LAATSTE REV.").Range("Q4") & "\" & "documentenlijsten\"

'Assemble a filename for the document
'In this case use the value that is in the first cell of the exported range and append date
sFileName = "document"

'Optional: make sure you have a unique filename
i = 1
While FileExists(sPath & "\" & sFileName & ".pdf")
i2 = InStr(1, sFileName & ".pdf", "(", vbTextCompare)
If i2 = 0 Then
sFileName = sFileName & "(" & i & ")"
Else
sFileName = Left(sFileName & "document.pdf", i2) & i & ")"
End If
i = i + 1
End Sub

De macro loopt vast op ( while file exists(spath & "\") enz.

Wie weet raad?

Toin

 

[MDN111]

Hallo !

Er begint een lus met While, maar er is geen Wend.

Grtz,
MDN111.

 

[sylvietoin]

Ho ho , dom dom, van mij natuurlijk, (ben beginner) heb je goed gezien MDN111 !!!


Macro aangepast maar, loopt weer vast op filename.

Heb nog geprobeerd om na wend de printout te plaatsten. maakt geen verschil.

ordernr. staat in Q4
werkblad heet laatste rev.
pdf moet geplaatst worden in:C:\ ordernr. \ documentenlijsten\ en dan de naam document.pdf krijgen.
Volgende pdf print moet naam ducument (2).pdf krijgen enz.

Sub PDFprinten()
'
' PDFprinten Macro
' De macro is opgenomen op 23-12-2008 door Toin Scheepers.
' 
'Deze routine print het werkblad laatste rev. als pdf onder C:\order\documentenlijsten\
'
    'Find the path to "C:/8606/DOCUMENTENLIJSTEN"
    Set oWSH = CreateObject("WScript.Shell")
    sPath = "c:\" & Worksheets("LAATSTE REV.").Range("Q4") & "\" & "documentenlijsten\"
    
    'Assemble a filename for the document
    'In this case use the value that is in the first cell of the exported range and append date
    sFileName = "document"
    
       'Optional: make sure you have a unique filename
    i = 1
    While FileExists(sPath & "\" & sFileName & ".pdf")
        i2 = InStr(1, sFileName & ".pdf", "(", vbTextCompare)
        If i2 = 0 Then
            sFileName = sFileName & "(" & i & ")"
        Else
            sFileName = Left(sFileName & "document.pdf", i2) & i & ")"
        End If
        i = i + 1
    Wend
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True  (  <==== Opgenomen met macro editor)

End Sub

Wie weet raad ?

Toin

 

[MDN111]

Hallo !

Het ontleden van jou code is nogal omslachtig voor mij omdat ik niet steeds weet wat je wil bereiken en ook omdat mijn kennis niet zo ver reikt (ik ben bijvoorbeeld niet vertrouwd met CreateObject("WScript.Shell"))

Als ik het goed begrijp heb je aan aantal bestanden in een folder en die heten Document(1).pdf, Document(2).pdf, Document(3).pdf, enz...en wil je een bestandsnaam creëren met een index die 1 groter is.

Om dat te bekomen kan je onderstaande functie gebruiken. Die kan je in je macro eenvoudig aanroepen met bijvoorbeeld

Dim MyNewFileName as string
MyNewFileName = GetNextFileName()

Mocht de functie niet in die vorm kunnen dienen dan kan je die wel zonder veel moeite aanpassen.

Option Explicit

Function GetNextFileName()
Dim fso As Object, oFile As Object
Dim cPath As String
Dim i As Integer, n As Integer

'Path aan te passen naargelang de behoefte.
cPath = "D:\Data\Temp"

'Het FileSystemObject geeft toegang tot de folders en files.
Set fso = CreateObject("Scripting.FileSystemObject")

'Alle bestanden doorlopen om de hoogste index op te zoeken.
n = 0
For Each oFile In fso.GetFolder(cPath).Files
  i = GetIndex(oFile.Name)
  If i > 0 Then
    n = IIf(i > n, i, n)  'Maximum waarde aanpassen indien index groter is.
  End If
Next

'Als we hier geraken heeft n de waarde van de hoogste index.
'Als de hoogste waarde 0 is, dan bestaat er nog geen bestand van het
'formaat "Document(*).pdf". Merk op dat we ook een 0 krijgen als een
'bestand "Document(0).pdf" zou bestaan, maar dat geeft niet.
GetNextFileName = cPath & Application.PathSeparator & "Document(" & CStr(IIf(n = 0, 1, n + 1)) & ").pdf"
End Function

Private Function GetIndex(ByVal cFile As String) As Long
Dim p1 As Long, p2 As Long

'De string "Document(" moet in de bestandsnaam voorkomen.
If InStr(UCase(cFile), "DOCUMENT(") = 0 Then Exit Function

'De bestandsnaam moet eindigen met ").pdf"
If Right(UCase(cFile), 4) <> ".PDF" Then Exit Function

'p1 geeft de positie van "(" in de bestandsnaam.
p1 = InStrRev(cFile, "(")

'Als "(" er niet in voorkomt komt het bestand niet in aanmerking.
If p1 = 0 Then Exit Function

'p2 geeft de positie van ")" in de bestandsnaam.
p2 = InStrRev(cFile, ")")

'Als ")" er niet in voorkomt komt het bestand niet in aanmerking.
If p2 = 0 Then Exit Function

'De haakjes moeten in de goede volgorde staan.
If p2 < p1 Then Exit Function

'Het gedeelte tussen de haakjes moet numeriek zijn.
If Not IsNumeric(Mid(cFile, p1 + 1, p2 - p1 - 1)) Then Exit Function

'Als we hier geraken komt het bestand in aanmerking en geven we de waarde
'van de index terug als Long. Merk op dat, als we de functie eerder verlaten,
'de teruggegeven waarde gelijk is aan 0, want die wordt automatisch
'toegewezen tijdens de initialisatie van de functie.
GetIndex = CLng(Mid(cFile, p1 + 1, p2 - p1 - 1))

End Function

Gtrz,
MDN111.