Dim FìNFILE As Integer Dim numFogli As Integer Public nomeFile As String Public Risposta As VbMsgBoxResult Public selrange As String Public indi As Object Dim e As Integer Public FILEATTIVO, NUOVOFILE As String ‘--------------------------------------------------------------------------------------------------------------- Public Sub CREA_REPORT() Dim iniTBL, FINETBL 'variabili a valore sub ApriFinestraDialogo ‘ Richiama Routine Set wks1 = Workbooks(FILEATTIVO) ' crea un set del file attivo numFogli = wks1.Worksheets.Count ' indica nel set precedente quanti fogli contiene Set wks2 = wks1.ActiveSheet ActiveSheet.Cells(2, 2).Select selrange = ActiveCell.CurrentRegion.AddressLocal selrange = VBA.Replace(selrange, "$", "") 'PULISCE LA STRINGA DAL SEGNO DOLLARO ActiveSheet.Range(selrange).Copy 'il set dell'area da copiare 'AGGIUNGE FOGLIO E GLI ASSEGNA IL NOME - DATA E ORA Workbooks(FILEATTIVO).Sheets.Add.Name = Year(Date) & Month(Date) & Day(Date) & "_" & Hour(Time) & "_" & Minute(Time) & "_" & Second(Time) Range(selrange).Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False 'libera la memoria Selection.Cells(1, 1).Select ActiveSheet.Copy CreaNuovoFileDaFoglio End Sub ‘----------------------------------------------------------------------------------------------- Sub ApriFinestraDialogo() ' Mostra la finestra di dialogo "Apri File" nomeFile = Application.GetOpenFilename(FileFilter:="File Excel (*.xls; *.xlsx), *.xls; *.xlsx", Title:="Seleziona un file Excel") On Error Resume Next 'GETIONE GENERICA DEGLI ERRORI ' Verifica se l'utente ha selezionato un file If nomeFile <> "False" Then ' Apri il file selezionato Workbooks.Open nomeFile Else ' Messaggio se l'utente ha annullato la finestra di dialogo MsgBox "Operazione annullata dall'utente." End If FILEATTIVO = ActiveWorkbook.Name 'Assegna a una variabile il nome del file aperto End Sub ‘----------------------------------------------------------------------------------------------- Sub CreaNuovoFileDaFoglio() Dim ws As Worksheet Dim NUOVOFILE As Workbook Dim nomeFile As String ' Imposta il foglio attivo come foglio selezionato Set ws = ActiveSheet ' Usa il nome del foglio selezionato per il nuovo file nomeFile = ws.Name ' Crea una nuova cartella di lavoro Set NUOVOFILE = ActiveWorkbook ' Rimuove eventuali fogli vuoti dal nuovo file Application.DisplayAlerts = False Application.DisplayAlerts = True ' Salva il nuovo file con il nome del foglio attivo nella cartella corrente NUOVOFILE.SaveAs ThisWorkbook.Path & "\" & "Report: " & nomeFile & ".xlsx" ' Messaggio di conferma MsgBox "Il nuovo file è stato creato con nome: " & " Report: " & nomeFile & ".xlsx" & " Nella posizione: " & ThisWorkbook.Path, vbInformation, "Conferma Creazione File" ' Chiudi il nuovo file NUOVOFILE.Close SaveChanges:=False End Sub