avevo questa macro che ora non capisco perche non funziona su un nuovo file creato.
In pratica ho 2 fogli in uno inserisco un numero delle settimane, lui mi cambia questo numero nei file desiderati ( salvati nel foglio due "macromese"), in modo da avere sempre i grafici aggiornati
Nel secondo foglio macro mese, ho tutti gli indirizzi dove deve andare a cambiarmi questo numero
es C:\pippo\pippo.xls grafici ecc, mi apre i fogli e mi cambia il numero
- Codice: Seleziona tutto
' Foglio1 - Worksheet
'
Option Explicit
Private Function GetRangeByAddress(ByVal Address As String) As Excel.Range
On Error Resume Next
Set GetRangeByAddress = Application.Range(Address)
End Function
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ErrH
Dim wbk As Excel.Workbook
Dim rng As Excel.Range
Dim rngOut As Excel.Range
Dim strAddr As String
Dim r As Long
Dim strPath As String
Dim strFilename As String
r = 1
Set rng = ThisWorkbook.Worksheets("Macromese").Cells(r)
strAddr = Me.Range(Mid$(rng.Formula, 2)).Address(External:=True)
If strAddr = Target.Address(External:=True) Then
Application.ScreenUpdating = False
Do
strAddr = Mid$(rng.Offset(r).Formula, 2)
Set rngOut = GetRangeByAddress(strAddr)
If rngOut Is Nothing Then
strPath = Split(strAddr, "!")(0)
strPath = Mid$(Left$(strAddr, InStrRev(strAddr, "\")), 2)
strFilename = Mid$(strAddr, Len("'" & strPath) + 2)
strFilename = Left$(strFilename, InStrRev(strFilename, "]") - 1)
strAddr = "'" & Mid$(strAddr, Len("'" & strPath) + 1)
Set wbk = Me.Application.Workbooks.Open(strPath & strFilename)
Set rngOut = GetRangeByAddress(strAddr)
End If
rngOut.Value = Target.Value
If wbk Is Nothing Then
' DO NOTHING
Else
wbk.Close True
Set wbk = Nothing
End If
r = r + 1
Loop While Len(rng.Offset(r).Value)
Else
' DO NOTHING
End If
ExtP:
Application.ScreenUpdating = True
Set rngOut = Nothing
Set rng = Nothing
Set wbk = Nothing
Exit Sub
ErrH:
MsgBox Err.Description
Resume ExtP
End Sub
Oppure c'è un metodo piu furbo, per forzare un numero su diversi fogli ad una determinata cella
grazie