Simone
- Codice: Seleziona tutto
Sub SalvaIn_xlsx_e_PDF()
Dim ws As Worksheet
Dim mfolder As String
Dim strFile As String
Dim Comune As String
Dim MsLink As String
Dim OdS As String
Dim FileExcelNuovo As String
Dim FilePDF As String
Dim oExcel As Excel.Application
Set oExcel = CreateObject("Excel.Application")
On Error GoTo RigaErrore
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
mfolder = .SelectedItems(1)
End If
End With
If mfolder <> "" Then '
' pulisce i risultati precedenti
Range("A2:f" & Rows.Count).ClearContents
' cartella contenente i file da modificare seguita da \
strFile = Dir(mfolder & "\" & "*.xlsm")
r = 2
'inizia ciclo lettura
Do While strFile <> ""
If strFile <> "SOS_3.xlsm" Then ' <<< DA MODIFICARE (è il nome del file che contiene _
questa macro e che può stare anche nella cartella con i file da modificare)
oExcel.Workbooks.Open mfolder & "\" & strFile
'If Filename = False Then
' MsgBox "Non è stato selezionato alcun file."
'Else
' MsgBox "E' stato selezionato il file: " & Filename
'End If
nomevero = strFile
'MsgBox "nomevero: " & nomevero
With oExcel.Sheets(1)
'MsgBox "Ho aperto il file: " & strFile
'strFile = Range("'Dati input accettazione'!$I$9") & "_" & Range("'Dati input accettazione'!$I$15") _
& ".pdf"
Comune = .Range("I9") & "_"
MsLink = .Range("I15")
OdS = .Range("E11")
'MsgBox "Ho selezionato 3 celle: " & Comune & "MsLink_" & MsLink & "_" & "OdS_" & OdS
strFile = Comune & "MsLink_" & MsLink & "_" & "OdS_" & OdS
'Salvataggio file excel con nome nuovo
FileExcelNuovo = "_" & strFile & ".xlsx"
'MsgBox "il file da scrivere è: " & FileExcelNuovo
oExcel.DisplayAlerts = False
oExcel.ActiveWorkbook.SaveAs (oExcel.ActiveWorkbook.Path & "\" & FileExcelNuovo), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
oExcel.DisplayAlerts = True
'MsgBox "Ho salvato il file Excel col nuovo nome"
'apre la finestra di dialogo per il salvataggio dei file
FilePDF = "_" & strFile & ".pdf"
'MsgBox "il file da scrivere è: " & FilePDF
oExcel.Sheets(4).Select
'MsgBox "Mi sposto sul fogio 4: "
'apre la finestra di dialogo per il salvataggio dei file
'la cartella di default è la stessa della cartella di excel
Set ws = oExcel.ActiveSheet
'MsgBox "rendo attivo il foglio "
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=(oExcel.ActiveWorkbook.Path & "\" & FilePDF), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'MsgBox "Il file PDF è stato salvato."
Cells(r, 1) = Format(r - 1, "0000") & " - "
Cells(r, 2) = nomevero
Cells(r, 3) = FileExcelNuovo
Cells(r, 4) = FilePDF
End With
oExcel.ActiveWorkbook.Close True
r = r + 1
End If
strFile = Dir
Loop
MsgBox "Procedura eseguita correttamente!"
End If
xit:
On Error Resume Next
oExcel.Quit
On Error GoTo 0
Set oExcel = Nothing
Range("A1").Select
Exit Sub
RigaErrore:
MsgBox "Errore n. " & Err.Number & " - " & Err.Description
Resume xit:
End Sub
