Scusa, mi era sfuggito.
Ecco il file con la modifica; ho aggiunto anche l'ora di creazione/modifica
http://www.filedropper.com/elencofogli_3Per chi fosse interessato allego il codice utilizzato nel file.
Questo va inserito nel modulo del workbook:
- Codice: Seleziona tutto
Option Explicit
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim R As Long
AddSheetName Sh
With ThisWorkbook.Worksheets(NomeElenco)
R = LastRow
.Cells(R, 1) = Sh.Name
.Cells(R, 2) = Now
End With
End Sub
Private Sub Workbook_Open()
InitSheetsList
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim CName As Range
With ThisWorkbook.Worksheets(NomeElenco)
If Sh.Name <> NomeElenco Then
UpdateSheetsList
Application.EnableEvents = False
For Each CName In Range(.Range("A1"), .Range("A1").End(xlDown))
If CName = Sh.Name Then
CName.Offset(0, 2) = Now
Exit For
End If
Next CName
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
UpdateSheetsList
End Sub
questo va in un modulo standard:
- Codice: Seleziona tutto
Option Explicit
Option Compare Text
Public Const NomeElenco = "Elenco"
Public Sub AddSheetName(Sh As Worksheet)
ThisWorkbook.Names.Add Name:="WS_" & Sh.Name, _
RefersTo:=Sh.Range("A1"), Visible:=False
End Sub
Public Sub UpdateName(Name As Name)
If Not Name Is Nothing Then
Name.Name = "WS_" & Name.RefersToRange.Worksheet.Name
End If
End Sub
Public Function SheetExistsByName(shName As String) As Boolean
Dim Sh As Worksheet
SheetExistsByName = False
On Error Resume Next
Set Sh = ThisWorkbook.Worksheets(shName)
SheetExistsByName = Err.Number = 0
On Error GoTo 0
Set Sh = Nothing
End Function
Public Function GetNameBySheetName(shName As String) As Name
Set GetNameBySheetName = Nothing
On Error Resume Next
Set GetNameBySheetName = ThisWorkbook.Names("WS_" & shName)
On Error GoTo 0
End Function
Public Function GetNameByRange(shName As String) As Name
Dim Name As Name
Set GetNameByRange = Nothing
If SheetExistsByName(shName) Then
For Each Name In ThisWorkbook.Names
If Not Name.Visible Then
If NameHasValidRange(Name) Then
If Name.RefersToRange.Worksheet.Name = shName Then
Set GetNameByRange = Name
Exit Function
End If
End If
End If
Next Name
End If
End Function
Public Function NameHasValidRange(Name As Name) As Boolean
Dim rTest As Range
On Error Resume Next
Set rTest = Name.RefersToRange
On Error GoTo 0
NameHasValidRange = Not rTest Is Nothing
Set rTest = Nothing
End Function
Public Sub ClearWsNames()
Dim Name As Name
For Each Name In ThisWorkbook.Names
If Left(Name.Name, 3) = "WS_" And Not Name.Visible Then Name.Delete
Next Name
End Sub
Public Function GetSheetName(Name As Name) As String
If NameHasValidRange(Name) Then
GetSheetName = Name.RefersToRange.Worksheet.Name
Else
GetSheetName = ""
End If
End Function
Public Function EmptyList() As Boolean
With ThisWorkbook.Worksheets(NomeElenco)
EmptyList = .Range("A1").End(xlDown).Row = .Rows.Count
End With
End Function
Public Function LastRow() As Long
If EmptyList Then
LastRow = 2
Else
LastRow = ThisWorkbook.Worksheets(NomeElenco).Range("A1").End(xlDown).Row + 1
End If
End Function
Public Sub UpdateSheetsList()
Dim I As Long, LR As Long
Dim Name As Name, SheetName As String
Application.EnableEvents = False
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets(NomeElenco)
LR = .Range("A1").End(xlDown).Row
If LR < Rows.Count Then
For I = LR To 2 Step -1
SheetName = .Cells(I, 1)
If Not SheetExistsByName(SheetName) Then
Set Name = GetNameBySheetName(SheetName)
If Not Name Is Nothing Then
If NameHasValidRange(Name) Then
UpdateName Name
.Cells(I, 1) = GetSheetName(Name)
Else
Range(.Cells(I, 1), .Cells(I, 3)).Delete (xlShiftUp)
Name.Delete
End If
End If
End If
Next I
End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Public Sub InitSheetsList()
Dim Sh As Worksheet
Dim R As Long
If EmptyList Then
ClearWsNames
R = 2
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> NomeElenco Then
AddSheetName Sh
ThisWorkbook.Worksheets(NomeElenco).Cells(R, 1) = Sh.Name
R = R + 1
End If
Next Sh
End If
End Sub
Ho preso lo spunto da questo articolo di Chip Pearson:
http://www.cpearson.com/excel/RenameProblems.aspxI nomi dei fogli vengono memorizzati per mezzo di Names (nomi definiti) nascosti (WS_NomeDelFoglio).
Nel name viene memorizzato un riferimento alla cella A1 del foglio, che rimarrà valido anche se il foglio viene rinominato.
Per mezzo di questo riferimento è possibile ottenere il nome reale del foglio che contiene la cella.
Se il riferimento non è valido, significa che il foglio è stato cancellato.
Workbook_SheetChange viene usato per aggiornare la data di ultima modifica, mentre con Workbook_NewSheet viene aggiunto un nuovo nominativo (e relativo Name) alla lista.
La lista viene aggiornata, tramite Workbook_SheetActivate, ogni volta che si seleziona un foglio.
La costante
- Codice: Seleziona tutto
Public Const NomeElenco = "Elenco"
viene usata per definire il nome del foglio che contiene l'elenco.