Mi limito a riprendere l' idea di usare l' evento WorksheetChange per aprire i file di cui in un' area nota si segnano directory e nome.
Partiamo ad esempio da una situazione come da figura:
Uploaded with
ImageShack.usL' area in giallo (variabile in quanto a posizione, altezza e larghezza) descrive i file che saranno poi usati nelle formule con Indiretto; le due colonne adiacenti (G e H, nell' esempio) saranno usate dalla macro per indicare il "nome pieno" (directory e nome file) di ogni riga di dati e lo stato di questo file.
Si noti che in queste celle deve essere riportato quanto serve per ricreare il nome pieno del file (es C:\Users\Anthony\Documents\cartel1234.xls), mentre la stringa che sara' usata con Indiretto sara' costruita separatamente (es C:\Users\Anthony\Documents\[cartel1234.xls]NomeFoglio!$A$1:$Z$100) sara' costruita altrove usando come sorgente le stesse celle.
Le celle devono contenere tutti i caratteri necessari a ricreare il nome completo, compreso i "\".
La seguente macro va posizionata nel modulo di codice del foglio in cui e' presente la tabelle:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IndirArea As String, NomeF As String, myArea As Range, FileCol As Long
Dim I As Long, J As Long, myWBN As String, OkWB, StayOpen As Boolean, TryOp
'
IndirArea = "$C$1:$F$3" '<< L' area dove e' composto Dir + Nome file
FileCol = 3 '<< la colonna di IndirArea ove si trova Nome file
OkWB = Array("Personal.xls", "Personal.xlsm", "cartel4") '<<< Elenco file che possono rimanere aperti
'
If Application.Intersect(Target, Range(IndirArea)) Is Nothing Or Target.Count <> 1 Then Exit Sub
For J = 1 To Range(IndirArea).Rows.Count
NomeF = ""
For I = 1 To FileCol
NomeF = NomeF & Range(IndirArea).Cells(J, I).Value
Next I
Range(IndirArea).Cells(J, 2 + Range(IndirArea).Columns.Count).Value = NomeF
ReReady:
If CheckIfOpen(Range(IndirArea).Cells(J, FileCol).Value) Then
Range(IndirArea).Cells(J, 1 + Range(IndirArea).Columns.Count).Value = "Pronto"
Else
TryOp = myWbOpen(Range(IndirArea).Cells(J, 2 + Range(IndirArea).Columns.Count).Value)
If TryOp Then
Range(IndirArea).Cells(J, 1 + Range(IndirArea).Columns.Count).Value = "Pronto"
Else
Range(IndirArea).Cells(J, 1 + Range(IndirArea).Columns.Count).Value = "Non pronto"
End If
End If
Next J
'Controlla quale dei file aperti deve rimanere aperto
For I = Workbooks.Count To 1 Step -1
myWBN = Workbooks(I).Name
StayOpen = False
If myWBN <> ThisWorkbook.Name And IsError(Application.Match(myWBN, OkWB, 0)) Then
For J = 1 To Range(IndirArea).Rows.Count
If Len(Range(IndirArea).Cells(J, 2 + Range(IndirArea).Columns.Count).Value) <> _
Len(Replace(UCase(Range(IndirArea).Cells(J, 2 + Range(IndirArea).Columns.Count).Value), UCase(myWBN), "")) Then
StayOpen = True
End If
Next J
If StayOpen = False Then Workbooks(I).Close 'savechanges:=True
End If
Next I
End Sub
Il seguente codice andrebbe invece posizionato in un Modulo standard:
- Codice: Seleziona tutto
Function CheckIfOpen(ByVal myWb As String) As Boolean
Dim PipWb
On Error Resume Next
Set PipWb = Workbooks(myWb)
If PipWb Is Nothing Then
CheckIfOpen = False
Else
CheckIfOpen = True
End If
On Error GoTo 0
End Function
Function myWbOpen(ByVal myWbFull As String) As Boolean
Dim mySplit
On Error Resume Next
Workbooks.Open myWbFull, 1, True
On Error GoTo 0
ThisWorkbook.Activate
mySplit = Split(" " & myWbFull, "\")
If CheckIfOpen(mySplit(UBound(mySplit))) Then myWbOpen = True
End Function
Le righe marcate << vanno personalizzate
In particolare
1) la variabile FileCol indichera' quale delle colonne contiene in nome del file da aprire (e' cioe' possibile che alcune colonne dell' area monitorata non siano destinate a contenere elementi del nome pieno del file; ad esempio per contenere il nome del foglio che va usato).
2) OkWB conterra' l' elenco dei file che vanno tenuti aperti, in aggiunta allo stesso file che contiene la macro; tutti gli altri verranno chiusi dalla macro.
L' eventuale salvataggio di dati alla chiusura dei file va gestita dall' utente; tuttavia e' possibile modificare l' istruzione If StayOpen = False Then Workbooks(I).Close per aggiungere l' informazione savechanges:=True oppure savechanges:=False
Uso:
Modificando le celle dell' area definita nella riga IndirArea = .... la macro:
-calcola il nome completo del file, che viene scritto nella colonna H
-il file viene aperto, e se l' operazione ha successo si scrive Pronto nella colonna G
-i file inutili (quelli diversi da quanto definito in OkWB) vengono chiusi (come gia' descritto prima)
Essendo i file aperti sara' possibile usare le formule con Indiretto da cui siamo partiti.
Ciao