Ciao Norman non è un problema, è frutto di un tuo precedente codice che mi incolla una matricola in una cella di 4 fogli di lavoro su cui ho inserito delle formule che prelevano i dati da altri fogli di lavoro.
Diciamo che tutto funziona benissimo e produce i Files pdf su cui stai elaborando il codice dell'altro post.
Io desidero che, anziché premere aggiorna ogni qual volta il tuo codice (che posto) incolla la matricola sui 4 fogli di Excel questo si bypassato e non mi costringa a farlo manualmente.
Spero di essere stato chiaro e comprensibile.
Public Sub Tester2()
Dim srcWB As Workbook, destWB As Workbook
Dim srcSH As Worksheet, destSH As Worksheet
Dim srcRng As Range, destRng As Range
Dim RngSelelezionaFile As Range
Dim arrIn As Variant, arrOut() As Variant
Dim arrFile As Variant, arrSiNo As Variant
Dim aStr As String, sStr As String
Dim sPath As String, sPathPdf
Dim sFile As String, sFilename As String, sFilename2 As String
Dim i As Long, j As Long, k As Long
Dim p As Long, q As Long, x As Long
Dim LRow As Long
Dim Res As VbMsgBoxResult
Const sDestCella = "U7" '<<=== Modifica
Const sEstensione As String = ".xlsm"
Const sRicerca As String = "Matricola" '<<=== Modifica
Const sOtherWorkbooks As String = _
"2004," _
& "2007," _
& "2009," _
& "2010"
Const sColonne As String = "BN:BQ" '<=== Modifica
Const sPercorsoPdf As String = "C:\Users\Nicola\Desktop\Nuova cartella" '<=== Modifica
With Application
.ScreenUpdating = False
sStr = .PathSeparator
sPath = ThisWorkbook.Path & sStr
If Right(sPercorsoPdf, 1) = sStr Then
sPathPdf = sPercorsoPdf
Else
sPathPdf = sPercorsoPdf & sStr
End If
End With
arrFile = Split(sOtherWorkbooks, ",")
Set srcWB = ThisWorkbook
Set srcSH = srcWB.Sheets("Foglio1")
With srcSH
LRow = LastRow(srcSH, .Columns("A:A"))
Set srcRng = .Range("A1:A" & LRow)
Set RngSelelezionaFile = .Range(sColonne).Resize(LRow, 4)
End With
arrIn = srcRng.Value
arrSiNo = RngSelelezionaFile.Value
Res = MsgBox(Prompt:="Vuoi creare dei file Pdf, " _
& "anziché stampare i file?", _
Buttons:=vbYesNo, _
Title:="Pdf o Stampante?")
For j = 1 To UBound(arrIn, 1)
sStr = arrIn(j, 1)
If sStr <> sRicerca Then
k = k + 1
ReDim Preserve arrOut(1 To 5, 1 To k)
arrOut(1, k) = sStr
For x = 1 To UBound(arrSiNo, 2)
arrOut(x + 1, k) = arrSiNo(j, x)
Next x
End If
Next j
If CBool(k) Then
For p = 2 To UBound(arrOut, 1)
sFilename = sPath & arrFile(p - 2) & sEstensione
Set destWB = Workbooks.Open(sFilename)
Set destSH = destWB.Sheets(1)
Set destRng = destSH.Range(sDestCella)
For q = 1 To UBound(arrOut, 2)
If UCase(arrOut(p, q)) = UCase("S") Then
' da questo punto in poi ho aggiunto questo codice che nascone le righe vuote nel range indicato
'With destSH
'.Range("A40:X60").EntireRow.Hidden = True
'End With
destRng.Value = arrOut(1, q)
sFile = "_" & arrFile(p - 2)
sFilename2 = destRng.Value _
& sFile _
'& "_" & Format(Now, "yyyy_mm_ dd hh-mm") _
& ".pdf"
If Res = vbYes Then
destSH.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPathPdf & sFilename2, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
'destSh.PrintPreview
destSH.PrintOut
End If
destRng.ClearContents
End If
Next q
destWB.Close SAVECHANGES:=False
Next p
End If
MsgBox "Operazione scelta conclusa con successo!" '& Chr(13) & Chr(13) & _
"Sono stati prodotti nr." & j + x & "Files PDF ", vbInformation
XIT:
Application.ScreenUpdating = True
End Sub
P.S. se puoi poichè te lo dovevo chiedere, io ci ho provato ma non mi dice i veri files pdf prodotti, ho fatto queste prove in queste righe di codice ma quelli prodotti non sono quelli che mi dice il messaggio con questi parametri:
'& Chr(13) & Chr(13) & _
"Sono stati prodotti nr." & j + x & "Files PDF ", vbInformation
Ho cambiato anche in questo modo ma anche qui è sbagliato il nr dei files realmente prodotti:
'& Chr(13) & Chr(13) & _
"Sono stati prodotti nr." & p + q & "Files PDF ", vbInformation
Come fare per far uscire tramite MsgBox il nr. preciso dei Files pdf relamente prodotti nella cartella predefinita?
Ciao Norman.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
