A volte può essere utile conoscere alcune caratteristiche del nostro file sul quale stiamo lavorando.
Per acquisire queste informazioni VBA ci mette a disposizione tre proprietà dell'oggetto Workbook:
Voi direte: ma che ce ne facciamo di queste proprietà se non sappiamo poi come utilizzarle?
Avete perfettamente ragione. Anch'io non mi metto a perdere tempo ad approfondire cose di cui non vedo l'utilità.
In realtà queste tre proprietà dell'oggetto Workbook ci possono togliere ci possono tornare utili in più di una circostanza tra cui la possibilità di salvare la cartella o uno dei fogli di questa.
Ecco subito una routine di prova per testare queste tre proprietà:
Sub Test()
Dim Nome, Percorso, NomeCompleto
Nome = ActiveWorkbook.Name
Percorso = ActiveWorkbook.Path
NomeCompleto = ActiveWorkbook.FullName
Range("A1") = "Il nome del file è: " & Nome
Range("A2") = "Il nome del percorso del file è: " & Percorso
Range("A3") = "Il nome completo é: " & NomeCompleto
End Sub
il risultato di questo piccolo test col file con cui lo sto testando sarà questo:
Il nome del file è: gestione magazzino.xls
Il nome del percorso del file è: C:\Documenti
Il nome completo é: C:\Documenti\gestione magazzino.xls
Ma veniamo ad un esempio pratico.
In una gestione magazzino abbiamo questa situazione:
| GESTIONE MAGAZZINO 2003 | Magazzino | Smistamento | ||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Cod | Articolo | Sit Iniz | Carico | Scarico | Giac | Max Cons | Critico | Sit. Iniz | Carico | Consumo | Dep Att | Disponibile |
| A001 | art 1 | 10 | 370 | -230 | 150 | 64 | 5 | 230 | 84 | 151 | 301 | |
| A002 | art 2 | 3 | 165 | -30 | 138 | 31 | 1 | 30 | 31 | 0 | 138 | |
| A003 | art 3 | 50 | 50 | 0 | 100 | 0 | 7 | 0 | 0 | 7 | 107 | |
| A004 | art 4 | 25 | 50 | 0 | 75 | 0 | 8 | 0 | 0 | 8 | 83 | |
| A005 | art 5 | 35 | 120 | -35 | 120 | 10 | 4 | 35 | 19 | 20 | 140 | |
| A006 | art 6 | 21 | 79 | 0 | 100 | 0 | 6 | 0 | 0 | 6 | 106 | |
| A007 | art 7 | 6 | 95 | -25 | 76 | 0 | 3 | 25 | 0 | 28 | 104 | |
| A008 | art 8 | 5 | 120 | 0 | 125 | 0 | 3 | 0 | 0 | 3 | 128 | |
| A009 | art 9 | 13 | 80 | 0 | 93 | 0 | 1 | 0 | 0 | 1 | 94 | |
| A010 | art 10 | 10 | 120 | 0 | 130 | 0 | 2 | 0 | 0 | 2 | 132 | |
| A011 | art 11 | 0 | 150 | 0 | 150 | 0 | 1 | 0 | 0 | 1 | 151 | |
| A012 | art 12 | 25 | 100 | 0 | 125 | 0 | 5 | 0 | 0 | 5 | 130 | |
| A013 | art 13 | 27 | 100 | 0 | 127 | 0 | 5 | 0 | 0 | 5 | 132 | |
A fine anno dobbiamo iniziare una nuova gestione, e per far questo vogliamo creare un nuovo file nel quale dobbiamo conservare
Queste ultime due voci nella nuova cartella andranno sotto le voci
Vorremmo ottenere una situazione del genere:
| GESTIONE MAGAZZINO 2003 | Magazzino | Smistamento | ||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Cod | Articolo | Sit Iniz | Carico | Scarico | Giac | Max Cons | Critico | Sit. Iniz | Carico | Consumo | Dep Att | Disponibile |
| A001 | art 1 | 150 | 150 | 151 | 151 | 301 | ||||||
| A002 | art 2 | 138 | 138 | 0 | 0 | 138 | ||||||
| A003 | art 3 | 100 | 100 | 7 | 7 | 107 | ||||||
| A004 | art 4 | 75 | 75 | 8 | 8 | 83 | ||||||
| A005 | art 5 | 120 | 120 | 20 | 20 | 140 | ||||||
| A006 | art 6 | 100 | 100 | 6 | 6 | 106 | ||||||
| A007 | art 7 | 76 | 76 | 28 | 28 | 104 | ||||||
| A008 | art 8 | 125 | 125 | 3 | 3 | 128 | ||||||
| A009 | art 9 | 93 | 93 | 1 | 1 | 94 | ||||||
| A010 | art 10 | 130 | 130 | 2 | 2 | 132 | ||||||
| A011 | art 11 | 150 | 150 | 1 | 1 | 151 | ||||||
| A012 | art 12 | 125 | 125 | 5 | 5 | 130 | ||||||
| A013 | art 13 | 127 | 127 | 5 | 5 | 132 | ||||||
La nuova cartella avrà lo stesso nome della cartella corrente con l'aggiunta del nuovo anno di esercizio. Se il file ha un normale nome (Gestione magazzino) a questo verrà aggiunto il suffisso dell'anno successivo, se il file ha già tale suffisso (Gestione magazzino2003) gliene verrà assegnato uno nuovo (Gestione magazzino2004)
Questo che segue potrebbe essere un probabile listato:
Sub NuovaGestione()
Dim Intervallo As Range
Dim NumRighe, NumCol, R
Dim NumArt, PosIns
Dim FileCorrente, NuovoFile, Cartella
Dim VecchioAnno, NuovoAnno
' determino l'intervallo sul quale debbo lavorare
With Range("A1").CurrentRegion
NumRighe = .Rows.Count
NumCol = .Columns.Count
Set Intervallo = .Offset(2, 0).Resize(NumRighe - 2, NumCol)
End With
' acquisisco il numero degli articoli e memorizzo in una matrice i dati che voglio salvare:
' codice, articolo, giacenza attuale in magazzino, giacenza attuale in smistamento
' che sono rispettivamente alle colonne 1, 2, 6, 12
NumArt = Intervallo.Rows.Count
ReDim Scorte(1 To NumArt, 1 To 4)
With Intervallo
For R = 1 To NumArt
Scorte(R, 1) = .Item(R, 1) ' codice
Scorte(R, 2) = .Item(R, 2) ' articolo
Scorte(R, 3) = .Item(R, 6) ' giacenza attuale in magazzino
Scorte(R, 4) = .Item(R, 12) ' giacenza attuale in smistamento
Next
End With
' mi preparo a salvare il file corrente ed a
' creare il nuovo file col quale gestire il nuovo anno
' il nuovo file avrà lo stesso nome del vecchio con l'aggiunta
' del numero del nuovo anno come finale del nome
FileCorrente = ActiveWorkbook.Name
PosIns = 0
For R = 1 To Len(FileCorrente)
Select Case Mid(FileCorrente, R, 1)
Case "0" To "9"
PosIns = R
Exit For
End Select
Next
If PosIns <> 0 Then
VecchioAnno = Mid(FileCorrente, PosIns, 4)
NuovoAnno = Val(VecchioAnno) + 1
Else
VecchioAnno = "."
NuovoAnno = Year(Date) & "."
End If
NuovoFile = Replace(FileCorrente, VecchioAnno, NuovoAnno)
Cartella = ThisWorkbook.Path
ActiveWorkbook.Save
' ora il vecchio file è stato salvato ma non ancora chiuso
' per creare il nuovo file occorre salvare con nome il vecchio file
' e gli viene attribuito il nuovo nome
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Cartella & "\" & NuovoFile
' ora il vecchio file è stato salvato e quel che vediamo è il nuovo file
With Intervallo
' nel nuovo file copio dalla matrice le seguenti voci
' codice
' articolo
' giacenza attuale in magazzino
' giacenza attuale in smistament
' rispettivamente alle colonne 1, 2, 3, 9
NumRighe = Intervallo.Rows.Count
For R = 1 To UBound(Scorte)
.Item(R, 1) = Scorte(R, 1)
.Item(R, 2) = Scorte(R, 2)
.Item(R, 3) = Scorte(R, 3)
.Item(R, 9) = Scorte(R, 4)
Next
' a questo punto vengono cancellate tutte le colonne che sono indicate qui sotto
.Columns(4).ClearContents
.Columns(5).ClearContents
.Columns(7).ClearContents
.Columns(8).ClearContents
.Columns(10).ClearContents
.Columns(11).ClearContents
End With
End Sub
I commenti ritengo siano abbastanza espressi nel listato appena presentato, per cui mi esimo dal continuare lasciando a chi interessa il compito di sperimentare questa tecnica e, se può essere di una qualche utilità a qualcuno, ne sarei veramente felice.
Buon lavoro