Creazione di files Excel

Ultima modifica: 27-05-2016

 

Questa volta vedremo come creare dei files esterni ed esportarvi facilmente dei dati. Il problema che ci prefiggiamo di risolvere è questo.

Abbiamo un file Excel che contiene i nostri contatti ed i dati loro correlati. Questi dati possono essere di qualsiasi natura, non importa quale. Il nostro compito è quello di esportare ogni record dei nostri contatti in files esterni assegnando loro il nome dei nostri contatti.

Usando questa tabella di esempio dovremmo creare quattro files Excel nominati Bianchi.xlsx, Giorgio.xlsx, ecc in cui vanno scritti i relativi dati:

Bianchi 98 88 71 36 47 50

Per usare correttamente la routine qui presentata è bene disporre così i files e cartelle:

 

  A B C D E F G
1 Nome voce1 voce2 voce3 voce4 voce5 voce6
2 Giorgio 73 44 60 28 62 33
3 Giovanni 17 72 18 31 53 20
4 Rossi 95 56 40 52 54 42
5 Bianchi 98 88 71 36 47 50

 

Il codice usato

Il codice, dopo la solita dichiarazione delle variabili, è suddiviso in blocchi per meglio comprendere lo scopo dei simgoli frammenti di codice.

Nel blocco della dichiarazione delle variabili tra le altre si sota la
Dim App As New Excel.Application, Book As Excel.Workbook
che serve alla creazione silente di un altro oggetto Workbook necessario per esportare i dati su altri files Excel. La parola chiave New viene utilizzata per creare un oggetto in modo implicito e cioè una nuova istanza dell'oggetto in occasione del primo riferimento a tale oggetto. Pertanto non è necessario utilizzare l'istruzione Set per assegnare il riferimento all'oggetto.

Nel primo blocco vengono definiti il foglio da usare e la dimensione dell'intervallo da cui prelevare i dati. Nel ridimensionare l'intervallo vedngono usati la funzione Offset() per escludere dall'intervallo le intestazioni di colonna e la funzione Resize() per includere nell'intervallo le giuste righe e colonne.

Il secondo blocco serve per definire la directory dove salvare il lavoro ed individuare il file Excel "cartella_pers.xlsx" da usare come template per salvare le nuove cartelle. Questo file può essere formattato a piacimento. La proprietà Path restituisce un valore String che rappresenta il percorso completo della cartella di lavoro o del file rappresentato dalla cartella di lavoro specificata.

Col terzo blocco usiamo il FileSystemObject (FSO) per cercare e cancellare eventuali files precedentemente creati, eccetto il "cartella_pers.xlsx" (nomeFile), usando il metodo fso.DeleteFile oFile.
Questo si rende indispensabile in quanto, a volte, il metodo Application.DisplayAlerts = False sembra non voler funzionare quando si tenta di sovrascrivere un file e si potrebbe generare un
errore di run-time 1004: metodo 'SaveAs' dell'oggetto 'Workbook' non riuscito.

Col quarto blocco si giunge a quel che ci siamo prefissati.
In questo blocco viene aperto il file che funge da template usando l'istruzione Set Book = App.Workbooks.Add(nomeFile) che aggiunge il template alla cartella ancora vuota ed inizia la procedura di trasferimento dei dati una riga alla volta dal file di origine.
Il file di destinazione viene referenziato dal blocco With Book.Worksheets(1) e dai riferimenti di cella preceduti dal punto, il file di origine viene referenziato da Intervallo().
Finita la copia dei dati si passa al metodo SaveAs. Questo per salvare quel che abbiamo copiato nel template con un altro nome e lasciare inalterato il template stesso lasciandolo vuoto.

Col quinto blocco vengono chiusi gli oggetti ancora aperti per liberare risorse.
La parola chiave Nothing è utilizzata per annullare l'associazione tra una variabile oggetto e qualsiasi oggetto. Per assegnare Nothing a una variabile oggetto, utilizzare l'istruzione Set.

 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub CreaFileEdEsportaDati()
Dim fso As Object
Dim oFolder As Object, oFiles As Object, oFile As Object
Dim App As New Excel.Application, Book As Excel.Workbook
Dim PratFold, Parts, X, Src, nomeFile, tmpvar, Lista, NuovoFile As String
Dim Intervallo As Range
Dim Righe, Colonne, R, C

'   BLOCCO 1 =======================================================
'   scelta del foglio e dell'intervallo di lavoro
Sheets("Foglio2").Select
Righe = Range("A1").CurrentRegion.Rows.Count - 1
Colonne = Range("A1").CurrentRegion.Columns.Count
Set Intervallo = Range("A1").CurrentRegion.Offset(1, 0).Resize(Righe, Colonne)
'   BLOCCO 2 =======================================================
'   ricerca della directory di lavoro e del file da usare come template
PratFold = ActiveWorkbook.Path
Parts = Split(PratFold, "\")
For X = 0 To UBound(Parts) - 1
    Src = Src & Parts(X) & "\"
Next
Src = Src & "archivio\"
nomeFile = Src & "cartella_pers.xlsx"
'   BLOCCO 3 =======================================================
'   eliminare i files creati precedentemente
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(Src)
Set oFiles = oFolder.Files
tmpvar = oFiles.Count
If tmpvar > 1 Then
    tmpvar = 0
    For Each oFile In oFiles
        If oFile <> nomeFile Then
            fso.DeleteFile oFile
            tmpvar = tmpvar + 1
        End If
    Next
End If
Set fso = Nothing
Set oFolder = Nothing
Set oFiles = Nothing
'   BLOCCO 4 =======================================================
'   trasferimento dei dati e salvataggio dei nuovi files
Application.ScreenUpdating = False
For R = 1 To Righe
    NuovoFile = Intervallo(R, 1)
    App.Visible = False
    Set Book = App.Workbooks.Add(nomeFile)
    With Book.Worksheets(1)
        For C = 1 To Colonne
            .Cells(1, C) = Intervallo(R, C)
        Next
    End With
    Application.DisplayAlerts = False
    Book.SaveAs FileName:=Src & NuovoFile & ".xlsx", accessmode:=xlExclusive
    Book.Close SaveChanges:=False
    App.Quit
    Application.DisplayAlerts = True
Next
Application.ScreenUpdating = True
'   BLOCCO 5 =======================================================
'    fine lavori
App.Quit
Set App = Nothing
Set Book = Nothing
End Sub

Anche per ora è tutto.