Informazioni: postmaster@valcos47.it
Sub che permette la compilazione di un file con tabella
fogli e colonne adattabili. Il nuovo file viene salvato in un
percorso esterno al di fuori del pc. Utile per la sicurezza del
lavoro
Sub CreaNuovoFileESalvaSuPercorsoEsterno()
Dim wbNuovo As Workbook
Dim percorsoDiscoEsterno As String
Dim A, B, c, d As Integer
Dim NFOGLIO As String
Dim ETICHETTA As String
' Imposta il percorso completo del disco esterno (ad esempio, "D:\")
percorsoDiscoEsterno = InputBox("Inserire il percorso di salvataggio del file", "Percorso", " D:\")
' Crea un nuovo file di Excel
Set wbNuovo = Workbooks.Add
' Esegui le operazioni desiderate sul nuovo file (ad esempio, scrivi dati)
wbNuovo.Sheets(1).Range("A1").Value = Date
wbNuovo.Sheets(1).Columns("A:A").AutoFit
Sheets(1).Name = "TOTALI"
B = InputBox("QUANTI FOGLI SERVOONO IN QUESTO FILE", "INSERIMENTO FOGLI", 3)
For A = 1 To B - 1
NFOGLIO = InputBox("INDICARE IL NOME DA ASSEGNARE AL FOGLIO " & A, "NOMEFOGLIO")
wbNuovo.Sheets.Add.Name = NFOGLIO
MsgBox "DI SEGUITO ASSEGNARE LE ETICHETTE ALLE COLONNE", vbApplicationModal = False,
"ETICHETTE"
d = 1
For c = 1 To B
ETICHETTA = InputBox("ETICHETTA COLONNA > " & c, "ETICHETTA")
ETICHETTA = UCase(ETICHETTA)
wbNuovo.Worksheets(NFOGLIO).Cells(1, c).Value = ETICHETTA
wbNuovo.Worksheets(NFOGLIO).Cells(1, c).HorizontalAlignment = xlCenter
'wbNuovo.Worksheets(NFOGLIO).Columns(c).EntireColumn.AutoFit
wbNuovo.Worksheets(NFOGLIO).Columns(c).ColumnWidth = 20
Next c
'wbNuovo.Sheets(A).Columns(A).AutoFit
On Error Resume Next
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Next A
wbNuovo.Sheets(1).Select
' Salva il nuovo file su disco esterno
On Error Resume Next
K = MsgBox("SALVARE E CHIUDERE IL FILE NEL PERCORSO " & percorsoDiscoEsterno & " O TENERE
APERTO IL FILE", vbYesNo, "SALVATAGGIO")
If K = 6 Then
wbNuovo.SaveAs Filename:=percorsoDiscoEsterno & "Report" & "_" & Day(Date) & "_" &
Month(Date) & "_" & Year(Date) & " _" & Hour(Time) & "_" & Minute(Time) & ".xlsx"
Else
wbNuovo.Activate
wbNuovo.Sheets(1).Select
Exit Sub
End If
' Chiudi il file senza salvarlo (o personalizza il salvataggio)
wbNuovo.Close SaveChanges:=False
End Sub
