Stampare file PDF in base a determinati criteri di stampa.

Anonimo

Buon pomeriggio a tutti, ho trovato nello storico delle discussioni del forum il codice sottoriportato, l'ho adattato al mio scopo ed ho fatto alcune prove per testarlo e la stampa dei Pdf nella cartella avviene correttamente.

Ho bisogno del vostro aiuto per poter integrare il codice sottoriportato ( se ciò è possibile) al fine di stampare un determinato nr di files pdf della cartella poiché la mia ne contiene 8500.

Cioè è possibile decidere in base al nr.da stampare ( dal nr. 1 al nr. 100) oppure in base alla lettera dei files poiché tutti i miei files pdf hanno una lettera all'interno del nome, esempio : 111111A.pdf ; 222222B.pdf e cosi via.

Vi ringrazio in anticipo per l'aiuto che vorrete darmi

Ciao Nicola.

Option Explicit

#If VBA7 And Win64 Then

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

ByVal hwnd As Long, _

ByVal lpOperation As String, _

ByVal lpFile As String, _

ByVal lpParameters As String, _

ByVal lpDirectory As String, _

ByVal nShowCmd As Long) As Long

#Else

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

ByVal hwnd As Long, _

ByVal lpOperation As String, _

ByVal lpFile As String, _

ByVal lpParameters As String, _

ByVal lpDirectory As String, _

ByVal nShowCmd As Long) As Long

#End If

Sub printPDF()

Dim fso As Object ' Scripting.FileSystemObject

Dim fld As Object ' Scripting.Folder

Dim sStartFolder As String

sStartFolder = "C:\Users\xxxxxx\Desktop\Nuova cartella"

Set fso = CreateObject("Scripting.FileSystemObject")

Set fld = fso.GetFolder(sStartFolder)

Call RecursivelyPrint(fld, True)

Set fld = Nothing: Set fso = Nothing

End Sub

Sub RecursivelyPrint(fld As Object, bIncludeSubFolders As Boolean)

Dim fil As Object ' Scripting.File

Dim sfd As Object ' Scripting.Folder

Dim sPdfFile As String

Dim lRet As Long

'--- loop through each file in the folder

For Each fil In fld.Files

sPdfFile = fld.Path & "" & fil.Name

lRet = ShellExecute(0&, "Print", sPdfFile, vbNullString, vbNullString, 1)

If bIncludeSubFolders Then

For Each sfd In fld.SubFolders

Call RecursivelyPrint(sfd, True)

End If

End Sub

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Nicola,

Ciao Norman, tutte le mie prove da circa 1 ora non hanno fruttato nulla.

Non so perché ho provato a mettere come predefinita 3 stampanti diverse ed il problema non cambia.

Il tuo ultimo codice con l'aumento del tempo a 10 secondi funziona benissimo, non ci sono messaggi di errore ma i pdf non vengono stampati.

Eseguo il tuo codice iniziale che mi hai suggerito come diagnostico e tutto va bene.

Per quanto riguarda tutti i messaggi e le immagini relative alle stampanti che tu mi indichi a me non viene visualizzato nulla.

Nemmeno il numero dei files da stampare ( a stampante spenta, faccio click destro ma non si vedono i pdf da stampare), eppure la rotellina ( tipo barra di avanzamento) di Windows che esegue il codice gira , esce il messaggio:

dopodiché la stampa non avviene, nella stampante non viene visualizzato alcun file da stampare.

Stamattina ho provato il codice in un altro ufficcio con pc e stampante diversi e non ho riscontrato alcun problema.

Se per te costa ancora tanto tempo e sacrificio, possiamo pure lasciare andare Norman, non voglio impegnarti ancora per tanto tempo con la mi esigenza.

Decidi tu copsa fare Norman, io ti sono immensamente grato per tutto quello che hai fatto per me.

Non ho alcuna intenzione di rinunciare: l'importante è che tu abbia un codice funzionante!

P.S. eppure Norman come mai quando eseguo questo codice mi stampa tutti i pdf nella cartella, cosa c'è di diverso tra il tuo codice e questo?

Quel codice sfutta un API diverso ma, per gli scopi correnti, equivalente. Esso ha comunque il vantaggio che non sia necessario precisare il percorso o il nome del file AcroRd32.exe, o Acrobat.exe nel caso della versione a pagamento di Adobe.

Comunque, dato che tu hai impiegato con successo questo api, ho adattato di conseguenza il mio codice. Nota, tuttavia, che l'altro codice che hai utilizzato non è equivalente: si limita a stampare tutti i file in una directory e le sue sottodirectory.

Quindi, prova il seguente codice:

'===========>>

Option Explicit

#If VBA7 And Win64 Then

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

ByVal hwnd As Long, _

ByVal lpOperation As String, _

ByVal lpFile As String, _

ByVal lpParameters As String, _

ByVal lpDirectory As String, _

ByVal nShowCmd As Long) As Long

#Else

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

ByVal hwnd As Long, _

ByVal lpOperation As String, _

ByVal lpFile As String, _

ByVal lpParameters As String, _

ByVal lpDirectory As String, _

ByVal nShowCmd As Long) As Long

#End If

'----------->>

Public Sub Tester()

Dim fso As Object

Dim oFile As Object

Dim oFiles As Object

Dim oFolder As Object

Dim srcWB As Workbook

Dim srcSH As Worksheet

Dim srcRng As Range

Dim arrData As Variant, arrFiles() As Variant, arrHeaders As Variant

Dim i As Long, j As Long, k As Long, m As Long, n As Long, p As Long, q As Long

Dim x As Long, y As Long, z As Long

Dim LRow As Long

Dim iTemp As Long

Dim sPath As String, sStr As String

Dim sFilename As String, sMatch As String

Dim sFile As String

Dim Res As Variant

Dim arr As Variant, arrMatchAlpha() As Variant, arrStampa() As Variant

Dim iCtr As Long, jCtr As Long

Dim LB As Long, UB As Long

Dim iStartChar As Long, iEndChar As Long

Dim blAscending As Boolean, bStampato As Boolean, bMatchAlfa As Boolean

Const srcShName = "Elenco PDF"

Const sNameType As String = ".pdf"

Const sHeaders As String = "File Pdf, Data\Ora Stampato"

Const sPercorsoPdf As String = _

"C:\Users\Nicola\Desktop\Nuova cartella"

On Error GoTo ErrHandler

sStr = Application.PathSeparator

If Right(sPercorsoPdf, 1) <> sStr Then

sPath = sPercorsoPdf & sStr

Else

sPath = sPercorsoPdf

End If

Set srcWB = ThisWorkbook

With srcWB

On Error Resume Next

Set srcSH = .Sheets(srcShName)

On Error GoTo 0

If srcSH Is Nothing Then

arrHeaders = Split(sHeaders, ",")

Set srcSH = .Sheets.Add(Before:=.Sheets(1))

With srcSH

.Name = srcShName

.Range("A1:B1").Value = arrHeaders

End With

End If

End With

With srcSH

LRow = LastRow(srcSH, .Columns("A:A"))

If LRow = 1 Then

Set srcRng = .Range("A2:B" & LRow + 1)

Else

Set srcRng = .Range("A2:B" & LRow)

End If

End With

arrData = srcRng.Value

Set fso = CreateObject("Scripting.FileSystemObject")

Set oFolder = fso.GetFolder(sPath)

Set oFiles = oFolder.Files

For Each oFile In oFiles

With oFile

If .Name Like "*" & sNameType Then

i = i + 1

ReDim Preserve arrFiles(1 To 2, 1 To i)

arrFiles(1, i) = .Name

End If

End With

Next oFile

If i = 0 Then

Call MsgBox(Prompt:="Non ci sono trovati dei file del tipo " _

& sNameType & " nella cartella " & sPercorsoPdf & "!", _

Buttons:=vbCritical, _

Title:="NO PDF FILES FOUND - HELP!!!")

Exit Sub

End If

Res = Application.InputBox( _

Prompt:="Inserisci i numeri/lettere iniziale e finale," _

& " separati da un doppio punto," _

& " ad esempio 1:1000 oppure A:F", _

Default:="1:1000", _

Title:="Pdf da Stampare")

If Res = False Then

Call MsgBox( _

Prompt:="Non hai precisato i file da stampare - riprova!", _

Buttons:=vbCritical, _

Title:="Problema!")

Exit Sub

End If

arr = Split(Res, ":")

Select Case True

Case IsNumeric(arr(0)) And IsNumeric(arr(1))

sMatch = "StampaNumerica"

LB = CLng(arr(0))

UB = CLng(arr(1))

j = UB - LB + 1

Case (arr(0)) Like "[a-z,A-Z]" And arr(1) Like "[a-z,A-Z]"

sMatch = "StampaAlfa"

Case Else

MsgBox "Non hai precisato due numeri o due lettere - Riprova"

Exit Sub

End Select

If sMatch = "StampaNumerica" Then

ReDim Preserve arrStampa(1 To j, 1 To 1)

For k = 1 To i

For m = 1 To UBound(arrData, 1)

If arrFiles(1, k) = arrData(m, 1) Then

bStampato = True

Exit For

End If

Next m

If Not bStampato Then

iCtr = iCtr + 1

arrStampa(iCtr, 1) = arrFiles(1, k)

End If

bStampato = False

If iCtr = j Then

Exit For

End If

Next k

ElseIf sMatch = "StampaAlfa" Then

iStartChar = Asc(UCase(arr(0)))

iEndChar = Asc(UCase(arr(1)))

For y = iStartChar To iEndChar

q = q + 2

ReDim Preserve arrMatchAlpha(1 To q)

arrMatchAlpha(q - 1) = "??????" & Chr(y)

arrMatchAlpha(q) = Chr(y) & "?????"

Next y

For k = 1 To i

For z = LBound(arrMatchAlpha) To UBound(arrMatchAlpha)

If arrFiles(1, k) Like arrMatchAlpha(z) & "*.pdf" Then

For m = 1 To UBound(arrData, 1)

If arrFiles(1, k) = arrData(m, 1) Then

bStampato = True

Exit For

End If

Next m

If Not bStampato Then

iCtr = iCtr + 1

ReDim Preserve arrStampa(1 To iCtr)

arrStampa(iCtr) = arrFiles(1, k)

End If

bStampato = False

If iCtr = j Then

Exit For

End If

Next z

Next k

arrStampa = Application.Transpose(arrStampa)

End If

blAscending = True

If iCtr < j Then

Call MsgBox(Prompt:="Ci sono stati trovati solo " _

& iCtr _

& " file non stampati anziche' i " _

& j _

& " chiesti!", _

Buttons:=vbInformation, _

Title:="Controlla Numero di Documenti")

End If

Call QuickSort(arrStampa, 1, 1, iCtr, blAscending)

For x = LBound(arrStampa) To iCtr

sFilename = sPath & arrStampa(x, 1)

DoEvents

ShellExecute 0, "print", sFilename, vbNullString, vbNullString, 0

Application.Wait (Now + TimeValue("0:00:04"))

DoEvents

Next x

ReDim Preserve arrStampa(1 To UBound(arrStampa, 1), 1 To 2)

For i = LBound(arrStampa, 1) To UBound(arrStampa, 1)

arrStampa(i, 2) = Now

Next i

srcSH.Range("A" & LRow + 1).Resize(UBound(arrStampa, 1), 2) _

.Value = arrStampa

Call MsgBox(Prompt:=iCtr & " file sono stati passati alla stampante e " _

& iCtr _

& " record sono aggiunto al foglio " & srcShName, _

Buttons:=vbInformation, _

Title:="REPORT")

XIT:

On Error GoTo 0

Exit Sub

ErrHandler:

MsgBox "Error " & Err.Number _

& " (" & Err.Description & ") in procedure Tester of Module Module6"

End Sub

'<<=========

'--------->>

Public Sub QuickSort(SortArray, col, L, R, bAscending)

'\ Tom Ogilvy: http://goo.gl/ninpZW

'Originally Posted by Jim Rech 10/20/98 Excel.Programming

'Modified to sort on first column of a two dimensional array

'Modified to handle a second dimension greater than 1 (or zero)

'Modified to do Ascending or Descending

Dim i, j, x, y, mm

i = L

j = R

x = SortArray((L + R) / 2, col)

If bAscending Then

While (i <= j)

While (SortArray(i, col) < x And i < R)

i = i + 1

Wend

While (x < SortArray(j, col) And j > L)

j = j - 1

Wend

If (i <= j) Then

For mm = LBound(SortArray, 2) To UBound(SortArray, 2)

y = SortArray(i, mm)

SortArray(i, mm) = SortArray(j, mm)

SortArray(j, mm) = y

Next mm

i = i + 1

j = j - 1

End If

Wend

Else

While (i <= j)

While (SortArray(i, col) > x And i < R)

i = i + 1

Wend

While (x > SortArray(j, col) And j > L)

j = j - 1

Wend

If (i <= j) Then

For mm = LBound(SortArray, 2) To UBound(SortArray, 2)

y = SortArray(i, mm)

SortArray(i, mm) = SortArray(j, mm)

SortArray(j, mm) = y

Next mm

i = i + 1

j = j - 1

End If

Wend

End If

If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)

If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range)

If Rng Is Nothing Then

Set Rng = SH.Cells

End If

On Error Resume Next

LastRow = Rng.Find(What:="*", _

after:=Rng.Cells(1), _

Lookat:=xlPart, _

LookIn:=xlFormulas, _

SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious, _

MatchCase:=False).Row

On Error GoTo 0

End Function

'<<=========

===

Regards,

Norman

0 commenti

70 risposte aggiuntive

Anonimo

2015-10-22T20:14:42+00:00

Ciao Nicola,

Per dimostrare che il codice funziona per me, ho precisato la stampa di file 1:20 e ho ottenuto la seguente finestrina dello stampante:

In ogni modo, raffinando la ricerca, prova a eseguire la seguente versione:

'=========>>

Option Explicit

'--------->>

Public Sub Stampa_A_Richiesta()

Dim WB As Workbook

Dim sPath As String, sStr As String

Dim sFilename As String, sMatch As String

Dim Res As Variant

Dim arr As Variant

Dim i As Long, j As Long, iCtr As Long

Dim iStartChar As Long, iEndChar As Long

Dim sOldDir As String, sFile As String

Const sPercorso As String = "**C:\Users\Nicola\Desktop\Nuova cartella**" Const sPathAdobe As String = _

"C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"

10 On Error GoTo XIT

20 sStr = Application.PathSeparator

30 If Right(sPercorso, 1) <> sStr Then

40 sPath = sPercorso & sStr

50 Else

60 sPath = sPercorso

70 End If

80 Res = Application.InputBox(Prompt:="Inserisci i numeri/lettere iniziale e finale," _

& " separati da un doppio punto," _

& " ad esempio 1:1000 oppure A:F", _

Default:="1:1000", _

Title:="Pdf da Stampare")

90 If Res = False Then

100 Call MsgBox(Prompt:="Non hai precisato i file da stampare - riprova!", _

Buttons:=vbCritical, _

Title:="Problema!")

110 Exit Sub

120 End If

130 sOldDir = CurDir

140 ChDir sPercorso

150 arr = Split(Res, ":")

160 Select Case True

Case IsNumeric(arr(0)) And IsNumeric(arr(1))

170 sMatch = "StampaNumerica"

180 Case (arr(0)) Like "[a-z,A-Z]" And arr(1) Like "[a-z,A-Z]"

190 sMatch = "StampaAlfa"

200 Case Else

210 MsgBox "Non hai precisato due numeri o due lettere - Riprova"

220 Exit Sub

230 End Select

240 If sMatch = "StampaNumerica" Then

250 sFilename = Dir(sPath & "*.pdf")

260 sFile = sFilename

270 iCtr = arr(0)

280 Do While iCtr < arr(1) + 1

290 If iCtr Mod 30 = 0 Then

300 Application.Wait (Now + TimeValue("0:00:30"))

310 End If

320 DoEvents

330 Shell sPathAdobe & "X" & " /p /h " & sPath & sFilename, vbHide

340 iCtr = iCtr + 1

350 sFilename = Dir

360 Loop

370 ElseIf sMatch = "StampaAlfa" Then

380 iStartChar = Asc(UCase(arr(0)))

390 iEndChar = Asc(UCase(arr(1)))

400 For i = iStartChar To iEndChar

410 sFilename = Dir(sPath & "??????" & Chr(i) & "*.pdf")

420 Do While sFilename <> vbNullString

430 DoEvents

440 iCtr = iCtr + 1

450 If iCtr Mod 30 = 0 Then

460 Application.Wait (Now + TimeValue("0:00:30"))

470 End If

480 Shell sPathAdobe & " /p /h " & sPath & sFilename, vbHide

490 sFilename = Dir

500 Loop

510 Next i

520 End If

530 Exit Sub

XIT:

540 ChDir sOldDir

550 MsgBox "ictr: " & iCtr _

& vbNewLine _

& "sFile: " & sFile _

& vbNewLine _

& "sFilename:" & sFilename _

& vbNewLine & vbNewLine _

& "Dir(sPath & sFilename: " & Dir(sPath & sFilename) _

& vbNewLine & vbNewLine _

& "Riga di errore: " & Erl _

& vbNewLine & "Errore " & Err.Number _

& " (" & Err.Description & ") in procedura Stampa_A_Richiesta"

End Sub

'==========>>

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-22T20:36:48+00:00

Ciao Nicola,

Avevo trascurato di rispondere alla questione dell'ordine della stanpa sei documenti:

non ti voglio confondere, ho fatto solo delle prove (senza il tuo codice) a selezionare 100 pdf nella cartella di lavoro ( pur essendo messi in ordine di matricola) e in fase di stampa mi vengono fuori in modo non progressivo bensì mischiati ecco perché ti chiedevo se c'era la possibilità (oppure perdonami se sto dicendo una cavolata e il tuo codice appena inseriti i pdf da stampare li stampa in modo ordinato) di integrare il tuo codice con una funzione che in fase di stampa dei pdf inseriti nella InputBox li stampava in ordine progressivo e non a casaccio.

Quando si guarda il contenuto di una directory si vede una 'vista' dei file. Questa vista può essere modificata per vedere i file in ordine alfabetico, ordine di dimensione o di data ecc. Tuttavia, queste sono viste e non devono necessariamente riflettere l'ordine interna imposta dal sistema operativo. Se vuoi che i file siano stampati in un ordine determinata, si potrebbe passarli ad un array, ordinarli secondo l'ordine voluto e poi passare i file alla stampa in questo ordine.

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-23T07:04:39+00:00

Ciao Norman, buongiorno e grazie ancora per tutto.

Ho copiato il tuo ultimo codice in un nuovo modulo ed ottengo questo messaggio:

Ti allego l' immagine di come sono i file miei all'interno della cartella:

Ti chiedo (se è possibile, proprio perché il tuo codice lo utilizzerò per tutte le mie procedure lavorative che determinano la realizzazione dei files PDF, a volte con nomi diversi da quelli che ho creato in questi giorni e che sono 8500) se nel tuo codice tu potessi prevedere la funzione di una stampa dei pdf pilotata, cioè decidere di stamparli in ordine ( da decidere, su questo sei tu a consigliarmelo, in base alla tua professionalità e vasta competenza).

Inoltre, se in futuro dovessi avere la necessità di salvare i files con altro nomecome faccio dove e cosa cambiare i riferimenti a questi files nel tuo codice che hai creato cortesemente per me?

Ti sono grato immensamente per quello che fai per me.

Ciao Nicola.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-23T10:09:50+00:00

Ciao Nicola,

Ho copiato il tuo ultimo codice in un nuovo modulo ed ottengo questo messaggio:

Credo che stiamo riscalendo la stessa montagna :-)

Questo errore si riferisce alla riga 330 del codice, cioè:

330 Shell sPathAdobe & "X" & " /p /h " & sPath & sFilename, vbHide

L'errore significa che il file

"C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"

non è stato trovato, come avevo suggerito in precedenza. Quindi, ti prego di fammi vedere un imagine di questo file nella sua cartella.

Ti chiedo (se è possibile, proprio perché il tuo codice lo utilizzerò per tutte le mie procedure lavorative che determinano la realizzazione dei files PDF, a volte con nomi diversi da quelli che ho creato in questi giorni e che sono 8500) se nel tuo codice tu potessi prevedere la funzione di una stampa dei pdf pilotata, cioè decidere di stamparli in ordine ( da decidere, su questo sei tu a consigliarmelo, in base alla tua professionalità e vasta competenza).

Inoltre, se in futuro dovessi avere la necessità di salvare i files con altro nomecome faccio dove e cosa cambiare i riferimenti a questi files nel tuo codice che hai creato cortesemente per me?

Ti sono grato immensamente per quello che fai per me.

Una montatagna alla volta, Nicola! Prima di considerare l'ordine della stampa dei file, si deve assicurarsi della della capacità di stamparli in qualsiasi ordine - anche se io sono già in grado di farlo senza alcun impedimento!

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento