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-20T12:31:08+00:00

Ciao Norman, grazie come sempre per il gentilissimo e preziosissimo riscontro.

Allora: i files sono tutti in una cartella ( poiché li salvo tutti in questa);

hanno tutti il nome che inizia con 6 cifre ed una lettera finale es: 111111A_2004; 222222B_2007; 333333C_2007 ecc.

Io desidero poter decidere di stampare o in base ad un nr. da stabilire per esempio da 1 a 1000 oppure in base alla lettera per esempio tutti i file PDF che iniziano con la lettera A e finiscono con la lettera F.

Spero di essere stato chiaro e comprensibile, se hai bisogno di ulteriori chiarimenti chiedimeli pure.

Ciao Nicola.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-20T14:16:56+00:00

Ciao Norman, poiché i files sono tutti creati in un sol colpo ed in una cartella su "C\ProvaPDF" occorrerebbe solo decidere quanti PDF stampare senza altri problemi (questo è quello che mi occorre per la mia esigenza).

Tieni presente che con il primo codice postato questo già avviene, solo che me li stampa tutti una volta.

Io invece desidero poter stampare un numero inferiore di pdf poiché la stampa massiva di 8500 di PDF mi tiene molto tempo legato al PC perché prima li apre e poi li stampa.

Spero di essere stato chiaro, penso che per te sia semplice fare ciò.

Ciao Nicola.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-20T15:46:40+00:00
Ciao Nicola,

Non ti ho dimenticato ma sono stato molto occupato. Tuttavia vorrei porre ancora due domande:
- A parte di Adobe Acrobat Reader hai installato anche il programma completo Acrobat ?
- Se fai clic su un file PDF e selezioni l'opzione di stampa, quale stampante viene utilizzata?
===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-20T17:15:08+00:00

Ciao Norman, sul mio pc è installata la versione di Adobe Reader XI e quando faccio clic sul file PDF e seleziono l'opzione di stampa viene visualizzata la stampante predefinita del mio pc che è una Brother.

Invece se faccio clic con il tasto destro sul file pdf e scelgo stampa, questo viene aperto e stampato immediatamente senza potermi permettere di selezionare la stampante con la quale stampare il file pdf selezionato.

Norman, sono felice di sentirti vicno ad aiutarmi.

Ciao Nicola.
La risposta è stata utile?

0 commenti Nessun commento