Ciao Antony, ti ringrazio molto per la mano che mi stai dando. La questione si è complicata parecchio purtroppo
Comunque ho provato a lavorare sulla macro MacroInventory che avevi proposto nella discussione a cui mi rimandi con link nel tuo primo post in questa discussione.
Qui sotto c'è la macro esattamente come l'avevi fatta tu.
- Codice: Seleziona tutto
Sub MacroInventory()
'
Dim VBCodeMod
Dim StartLine As Long
Dim Msg As String
Dim ProcName As String
Dim VBComp
Dim ModName As String
Dim FileList As Worksheet, ProcList As Worksheet, myCFile As String
Dim I As Long, myNRow As Long, JJ As Long, myHLine As Long, TotFIles
Set FileList = ThisWorkbook.Sheets("Foglio1")
Set ProcList = ThisWorkbook.Sheets("Foglio2")
aaaa = FileList.Cells(Rows.Count, 2).End(xlUp).Row
'Riga di codice della macro che sara' inserita in Inventario
' 1=prima, 2= seconda, ...
myHLine = 1 '<<< Riga di codice della macro che sara' inserita in Inventario
Application.Calculation = xlManual
TotFIles = FileList.Cells(Rows.Count, 2).End(xlUp).Row
UserForm2.Show vbModeless
DoEvents: DoEvents
UserForm2.TextBox4 = TotFIles
For I = 1 To TotFIles
UserForm2.TextBox2 = I
myCFile = FileList.Cells(I, 2)
UserForm2.TextBox1.Text = myCFile
myNRow = ProcList.Cells(ProcList.Rows.Count, 7).End(xlUp).Row + 2
ProcList.Cells(myNRow, 7) = myCFile
ProcList.Cells(myNRow, 1) = "###_HEAD" 'Scritta che rimane in caso di errore sul file
ProcList.Cells(myNRow, 5) = Environ("ComputerName")
'
On Error GoTo myErr
myDate = FileDateTime(myCFile)
ProcList.Cells(myNRow, 4) = myDate
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Workbooks.Open myCFile, 0, True
Application.DisplayAlerts = True
mySplit = Split(myCFile, "\")
Workbooks(mySplit(UBound(mySplit, 1))).Activate
ProcList.Cells(myNRow, 1) = "##_" & mySplit(UBound(mySplit, 1)) 'Replace "##_HEAD"
'
myWKBook = ActiveWorkbook.Name
If Right(myWKBook, 5) = ".xlsx" Then GoTo WBClose 'Nessun check sulle macro se ".xlsx"
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
ModName = VBComp.Name
myMod = VBComp.Type '1=modulo; 100=Foglio /Thisworkbook; 3=Userform; lista non esaustiva
'
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(ModName).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .Countoflines
myProcedure = .ProcOfLine(StartLine, 0)
'cerca prima riga della macro:
For JJ = 0 To 20
myHead = VBCodeMod.Lines(StartLine + JJ, 1)
If myHead <> "" Then Exit For
If (StartLine + JJ) > .Countoflines Then JJ = 0: Exit For
Next JJ
'
myHead = VBCodeMod.Lines(StartLine + JJ + myHLine - 1, 1)
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, 0), 0)
'Salva info di macro in Foglio2:
myNRow = ProcList.Cells(ProcList.Rows.Count, 7).End(xlUp).Row + 1
ProcList.Cells(myNRow, 1) = ModName 'Nome Modulo
ProcList.Cells(myNRow, 2) = myProcedure 'Nome Macro
ProcList.Cells(myNRow, 3) = myMod 'Tipo di Modulo
ProcList.Cells(myNRow, 4) = myDate 'Data del file
ProcList.Cells(myNRow, 5) = Environ("ComputerName") 'Computer name
ProcList.Cells(myNRow, 6) = myHead 'Riga prescelta del codice
ProcList.Cells(myNRow, 7) = myCFile 'Full Path & Name del file
Loop
End With
Next VBComp
WBClose:
DoEvents
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
ActiveWorkbook.Close savechanges:=False
End If
On Error GoTo 0
Application.EnableEvents = True
Application.ScreenUpdating = True
Sheets("Foglio2").Select
Cells(Rows.Count, 7).End(xlUp).Offset(0, -6).Select
If UserForm2.CBStop = True Then
MsgBox ("La macro e' stata interrotta; riprenderla manualmente col tasto F5")
UserForm2.CBStop = False
End If
'Application.ScreenUpdating = True
Next I
'Fine elenco files
Application.Calculation = xlCalculationAutomatic
Calculate
MsgBox ("God willing, abbiamo finito...") 'Completamento job
Unload UserForm2
Exit Sub
myErr:
If Err.Number = 50289 Then
ProcList.Cells(myNRow, 6) = "VBProject PROTETTO...."
Resume WBClose
Else
Msg = "Errore " & Err.Number & vbCrLf & Err.Description
MsgBox (Msg)
ProcList.Cells(myNRow, 6) = "ERRORE tipo: " & Err.Number
'Resume 'Per vedere dove e' successo l' errore e debuggare
Resume WBClose
End If
Stop 'Qui non dovremmo mai arrivarci
Application.Calculation = xlCalculationAutomatic
Calculate
End Sub
Penso che devo utilizzare un codice simile a questo
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "A") = Range("A10").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "B") = Range("D10").Value '<<<
Oltre poi all'integrazione che mi hai proposto tu nel precedente messaggio per gli hyperlink.
Dunque a logica dichiaro
FileList e Proclist
Set FileList = ThisWorkbook.Sheets("Foglio1")
Set ProcList = ThisWorkbook.Sheets("Foglio2")
A questo punto con il ciclo For I / Next I apro ogni file e prendo le informazioni che mi servono per poi richiuderlo. Il fatto è che non riesco a modificare in un modo "funzionale" la tua macro... Non riesco a farla girare, perchè forse non ho ben chiaro la logica di base non avendo mai lavorato con VBA a differenza del C++.
Devo ammettere che è davvero frustrante stare davanti ad un monitor e non sapere cosa fare
Comunque è mia intenzione comprendere la logica e poi dopo lavorarci sopra, dove posso eventualmente trovare qualche info sul VBA per capire come lavorare?