Dde excel

Hai un problema con Excel?

Nuova discussione

Dde excel
di Robi (utente non iscritto) data: 30/03/2009
Ciao a tutti
sono digiuno di vba e pongo la seguente:
ho 1 cella che si aggiorna in automatico ogni tot secondi con dati di borsa.
mi servirebbe collezionare tutte le variazioni della cella su di una colonna in ordine di aggiornamento, aggiornamento che dovrei settarlo ad es. a 1 minuto.
come fare????? grazie

di R (utente non iscritto) data: 31/03/2009
Il codice qui sotto comprende una routine di evento da posizionare nel modulo di classe del foglio dove hai la cella col valore che cambia ...
ad ogni variazione della cella a1 viene scritto il rispettivo valore nel fogliolog (che viene creato in automatico se ancora assente nella cartella ... viene anche riportato il giorno e orario della lettura oltre all'username di chi ha aperto la cartella ...
modifica in base alle tue esigenze.
fai sapere
saluti
r

Option Explicit
'nel modulo di classe del foglio

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Excel.Range
Dim TuoRng As Excel.Range
Set TuoRng = [a1]
Static SalvaLoop As Boolean
If SalvaLoop Then Exit Sub
SalvaLoop = True
If TypeName(Intersect(Target, TuoRng)) = "Range" Then
    Set rng = A1FoglioLog("FoglioLog")
    rng.Value = TuoRng.Value
    rng.Offset(0, 1) = Environ("username")
    rng.Offset(0, 2) = Now
End If
SalvaLoop = False
End Sub

'in un modulo standard (per me meglio)
'oppure nel modulo di classe del foglio
'insieme alla routine di evento

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Enzo (utente non iscritto) data: 31/03/2009
Ciao roberto mi interesserebbe la tua routine ma me la potresti spiegare con un esempio semplice
per poterla applicare
di R (utente non iscritto) data: 31/03/2009
In che senso un esempio semplice?
la prima routine è una routine di evento change ... controllla che target interseca il tuo range in questo caso a1, se sì ... setta un range alla prima cella (utilizza ultimariga per vedere qual'è l'ultima riga valorizzata) libera del foglio log (se il foglio non esiste locrea) e ci scrive il valore poi sulla stessa riga aggiunge il nome utente e now ...
dimmi te i passaggi che non sono chiari eventuaalmente
saluti
r

per usarla basta incollare tutto nel modulo di classse di un foglio e scrivere in a1 vari valori ... vedrai il risultato
di Robi (utente non iscritto) data: 31/03/2009
Ciao roberto,
probabilmente sono io ad essere ciuco..
allora: ho copiato in un modulo tutta la formula, poi tramite "esegui" sul menù ho avviato la macro, ma nn succede nulla..
per quanto riguarda la rilevazione ed archiviazione del dde ogni es. 5 minuti, cosa bisogna aggiungere alla formula?
grazie tante
di R (utente non iscritto) data: 31/03/2009
Domanda: ho copiato in un modulo tutta la formula, poi tramite "esegui" sul menù ho avviato la macro, ma nn succede nulla..

risposta: no! non è quello che ho detto di fare ... la prima routine è una routine di evento devi incollarla nel modulo di classe del foglio dove hai la cella con i valori che si aggiornano ... quindi se l'hai nella cella a1 del foglio1 apri il progetto vba
menu visualizza->gestione progetti
troverai per esempio:
microsoft excel oggetti
-foglio1 (foglio1)
-pippo(foglio2)
-thisworkbook
moduli
-modulo1

etc...
dopio click su foglio1 e incolli la routine worksheet_change
in modulo1(o quel che sia) incolli le altre funzioni
adesso non dovrai lanciare nulla ... quando la cella a1 cambia valore (e bata che provi a cambiare valore e dare invio) il codice verrà eseguito nel modo già descritto precedentemente in altri post

domanda: per quanto riguarda la rilevazione ed archiviazione del dde ogni es. 5 minuti, cosa bisogna aggiungere alla formula?

risposta: non devi aggiungere nulla basta che modifichi nella routine worksheet_change che ho passato [a1] con l'indirizzo della cella che viene aggiornata

grazie tante
prego
r
di Robi (utente non iscritto) data: 01/04/2009
Ho seguito letue istruzioni
2 click foglio1 incollato questo:

option explicit

private sub worksheet_change(byval target as range)

dim rng as excel.range
dim tuorng as excel.range
set tuorng = [a1]
static salvaloop as boolean
if salvaloop then exit sub
salvaloop = true
if typename(intersect(target, tuorng)) = "range" then
set rng = a1fogliolog("fogliolog")
rng.value = tuorng.value
rng.offset(0, 1) = environ("username")
rng.offset(0, 2) = now
end if
salvaloop = false
end sub

su un modulo (non di classe) incollato il resto:

function a1fogliolog(ssh as string) as excel.range
dim sh as excel.worksheet
dim wb as excel.workbook
dim r as long
on error resume next
set wb = thisworkbook
set sh = wb.worksheets(ssh)
if err then
err.clear
set a1fogliolog = wb.worksheets.add().range("a1")
a1fogliolog.parent.name = ssh
else
r = ultimariga(sh) + 1
if r > sh.cells.rows.count then
sh.rows("2:1001").delete shift:=xlup
r = r - 1000
end if
set a1fogliolog = sh.cells(r, 1)
end if
on error goto 0
end function

function ultimariga(optional sh as worksheet, _
optional rng as range) as long

if sh is nothing then
if rng is nothing then
set rng = [a1].parent.usedrange
end if
else
set rng = sh.usedrange
end if

on error resume next
ultimariga = rng.find(what:="*", _
after:=rng.cells(1), _
lookat:=xlpart, _
lookin:=xlformulas, _
searchorder:=xlbyrows, _
searchdirection:=xlprevious, _
matchcase:=false).row
on error goto 0
end function

non accade nulla...devo essere proprio negato..
di Albatros (utente non iscritto) data: 01/04/2009
Allora con mooooolta calma!!!!
apri excel e apri un nuovo foglio ,pressa la combinazione dei tasti alt+f11 e sarai proiettato nell-editor di vba.
sulla finestra di sinistra avrai la lista dei fogli
doppia click sul foglio1, nella casella generale seleziona worksheet sulla stessa righa ma a destra seleziona evento change e incolli il codice dell'evento change.
vai sul menu inserisci e inserisci un modulo, fatto questo copia e incolla il codice delle funzioni.
fatto questo vai sul foglio1 di excel cambia il valore della cella a1 e tutto dovrebbe funzionare.
ciao
albatros
di Robi (utente non iscritto) data: 01/04/2009
Niente....non và... ci deve pur essere una soluzione...
di Albatros (utente non iscritto) data: 01/04/2009
Ma se io l'ho provata e' funziona
di Robi (utente non iscritto) data: 01/04/2009
Inserisco su "foglio1(codice)":

dim rng as excel.range
dim tuorng as excel.range
set tuorng = [a1]
static salvaloop as boolean
if salvaloop then exit sub
salvaloop = true
if typename(intersect(target, tuorng)) = "range" then
set rng = a1fogliolog("fogliolog")
rng.value = tuorng.value
rng.offset(0, 1) = environ("username")
rng.offset(0, 2) = now
end if
salvaloop = false

su "modulo1 (codice)":

function a1fogliolog(ssh as string) as excel.range
dim sh as excel.worksheet
dim wb as excel.workbook
dim r as long
on error resume next
set wb = thisworkbook
set sh = wb.worksheets(ssh)
if err then
err.clear
set a1fogliolog = wb.worksheets.add().range("a1")
a1fogliolog.parent.name = ssh
else
r = ultimariga(sh) + 1
if r > sh.cells.rows.count then
sh.rows("2:1001").delete shift:=xlup
r = r - 1000
end if
set a1fogliolog = sh.cells(r, 1)
end if
on error goto 0
end function

function ultimariga(optional sh as worksheet, _
optional rng as range) as long

if sh is nothing then
if rng is nothing then
set rng = [a1].parent.usedrange
end if
else
set rng = sh.usedrange
end if

on error resume next
ultimariga = rng.find(what:="*", _
after:=rng.cells(1), _
lookat:=xlpart, _
lookin:=xlformulas, _
searchorder:=xlbyrows, _
searchdirection:=xlprevious, _
matchcase:=false).row
on error goto 0
end function

e continua a nn cambiare nulla...
di Albatros (utente non iscritto) data: 01/04/2009
Fai la prova a cambiare il valore della cella a1 e vedi se ti crea il foglio log e ti scrive nelle celle dello stesso foglio le variazioni, il valore lo devi cambiare tu non lo cambia ogni 5 minuti come tu ti aspetti
di Robi (utente non iscritto) data: 01/04/2009
Albatros, puoi inviarmi il file excel? così nn impazzisco...sidish@libero.it. grazie
di Robi (utente non iscritto) data: 01/04/2009
Grazie albatros, ma il problema permane, ovvero mi riporta un solo valore "n/d" e non incolonna i vari aggiornamenti della cella a1..boh
di Robi (utente non iscritto) data: 01/04/2009
Grazie albatros, ma il problema permane, ovvero mi riporta un solo valore "n/d" e non incolonna i vari aggiornamenti della cella a1. i valori nella cella a1 sono dati dde.
boh....
di Albatros (utente non iscritto) data: 01/04/2009
Scusa ma con dde che intendi? non sono valori numerici?
di Robi (utente non iscritto) data: 01/04/2009
Certo, sono quotazioni che arrivano in automatico in a1 tramite una macro e che si aggiornano in continua
di Robi (utente non iscritto) data: 02/04/2009
Quella routine funziona solo se immetti ivalori manualmente in a1, ma con il dde non và.
riporta solo il primo valore in fogliolog ed inoltre blocca l'aggiornamento dde in a1.
di R (utente non iscritto) data: 02/04/2009
Vedere tuo codice ... dare soluzione
ciao
r

di Robi (utente non iscritto) data: 02/04/2009
Mi sto scervellando...in pratica la macro non fà aggiornare il dde, funziona solo manualmente.
sul sito microsoft per ovviare al problemma dde propongono la macro linklist.che ovviamente non sò come e dove posizionare.

albatros e roberto in aiuto!

Sub LinkList() 
   Dim Links As Variant 
   ' Obtain an array for the links to Excel workbooks 
   ' in the active workbook. 
   Links = ActiveWorkbook.LinkSources(xlOLELinks) 
   ' If the Links array is not empty, then open each 
   ' linked workbook. If the array is empty, then 
   ' display an error message. 
   If Not IsEmpty(Links) Then 
       For I = 1 To Ubound(Links) 
           ActiveWorkbook.SetLinkOnData Links(i), "LinkChange" 
       Next I 
   Else 
       MsgBox "This workbook does not contain any links " & _ 
       "to other workbooks" 
   End If 
End Sub

di Robi (utente non iscritto) data: 02/04/2009
La macro dde in a1 è un collegamento ad un software chiamato metatrader
ad es. quotazione euro/usd la macro è: =mt4|bid!eurusd che fornisce il dato tick per tick
di R (utente non iscritto) data: 02/04/2009
Il tuo codice e il link della pagina microsoft
grazie
r
di R (utente non iscritto) data: 02/04/2009
Hai sostituito [a1] con [eurusd] ?
di R (utente non iscritto) data: 02/04/2009
Scusa ho detto una stronzata!
il problema è che dde è una formula quindi non va bene l'evento change devi spostare il codice nell'evento calculate
sei capace?
di Robi (utente non iscritto) data: 02/04/2009
Ho inserito: private sub worksheet_calculate(byval target as range) in foglio1(codice) ma non cambia nulla..
l'indirizzo page di microsoft support.microsoft.com/default.aspx?scid=kb%3bit%3b172832

di R (utente non iscritto) data: 02/04/2009
Metti tutto nel modulo di classe thisworkbook
poi salva, chiudi e riapri ... dovrebbe andare
fai sapere
saluti
r

Option Explicit
Dim rngbase
Private Sub Workbook_Open()
rngbase = [foglio1!a1].Value
End Sub
'nel modulo di classe del foglio
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Excel.Range
Dim TuoRng As Excel.Range
Set TuoRng = [foglio1!a1]
If TuoRng.Parent.Name = Sh.Name Then
    If TuoRng.Value <> rngbase Then
        Set rng = A1FoglioLog("FoglioLog")
        rng.Value = TuoRng.Value
        rng.Offset(0, 1) = Environ("username")
        rng.Offset(0, 2) = Now
        rngbase = TuoRng.Value
    End If
End If
End Sub

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Robi (utente non iscritto) data: 02/04/2009
Miticoooooo!
grazie roberto!
dammi l'ultima dritta e poi ti accendo un cero!

se volessi l'aggiornamento solo ogni minuto? chiedo troppo??

di R (utente non iscritto) data: 02/04/2009
L'aggiornamento del dde ogni minuto?
suppongo che dovresti usare il codice che hai scaricato richiamandolo con ontime ...

potresti anche avere in una colonna i dati separati dall'anno ai minuti così poi eventualmente puoi vedere più dettagliatamente ...
vedi codice qui sotto
saluti
r

Option Explicit
Dim rngbase
Private Sub Workbook_Open()
rngbase = [foglio1!a1].Value
End Sub
'nel modulo di classe del foglio
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Excel.Range
Dim TuoRng As Excel.Range
Set TuoRng = [foglio1!a1]
If TuoRng.Parent.Name = Sh.Name Then
    If TuoRng.Value <> rngbase Then
        Set rng = A1FoglioLog("FoglioLog")
        rng.Value = TuoRng.Value
        rng.Offset(0, 1) = Environ("username")
        rng.Offset(0, 2) = Now
        rng.Offset(0, 3) = VBA.Year(Now)
        rng.Offset(0, 4) = VBA.Month(Now)
        rng.Offset(0, 5) = VBA.Day(Now)
        rng.Offset(0, 6) = VBA.Hour(Now)
        rng.Offset(0, 7) = VBA.Minute(Now)
        rngbase = TuoRng.Value
    End If
End If
End Sub

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Robi (utente non iscritto) data: 02/04/2009
Ti faccio sapere
grazie ancora!!
di Robi (utente non iscritto) data: 03/04/2009
Ciao roberto,

l'ultima routine che hai scritto lavora come l'altra, ovvero incolonna ogni aggiornamento.sarebbe utile che aggiornasse solo ogni 1 minuto .
grazie
di R (utente non iscritto) data: 03/04/2009
Ciao,
se hai la necessità che l'aggiornamento sia effettuato ogni minuto ... bisogna agire sull'evento calculate e utilizzare quindi gli eventi del workbook.
dde non lo conosco bene ma da ciò che ho capito funziona come una formula che quindi è sempre attiva, ciò che posso vedere di realizzare è:
primo caso qualcosa tipo impostare il ricalcolo manuale e farlo eseguire ogni minuto, puoi provarlo anche manualmente stumenti->opzioni-> scheda calcolo spunti manuale ... poi ogni volta che vuoi il ricalcolo f9

la seconda soluzione sarebbe quella di utilizzare la routine che hai trovato nel sito microsoft richiamandola ogni minuto ... probabilmente sarebbe la soluzione migliore ma io non posso fare prove posso solo fornirti una routine che ne chiama un altra ogni minuto

terza soluzione lascia tutto come è adesso e quando vuoi puoi pulire i dati di foglio log nel modo che ritieni migliore

quarta soluzione se per te non è un problema il fatto che dde funzioni come adesso, posso adattare il codice affinchè faccia una verifica dell'orario ... tipo se il dato cambia ed è trascorso almeno un minuto dall'ultimo aggiornamento allora aggiungi una riga al foglio log altrimenti no

valuta quale scenario vuoi e fai sapere ... appena possibile vedrò di darti la soluzione
saluti
r
di Robi (utente non iscritto) data: 03/04/2009
Ciao roberto,
penso che l'ultima soluzione sia la migliore.

piccolo problema: se ho 2 file, ognuno salvato con una quotazione diversa dall'altro, ogni aggiornamento che avviene nel 1^ viene riportato anche nel 2^ file e viceversa.
è strano perchè all'inizio non lo faceva.
grazie x la tua competenza

di R (utente non iscritto) data: 03/04/2009
Il motivo dell'aggiornamento è probabilmente dovuto al fatto che le modifiche richiamano altri eventi (change) ...
nel codice qui sotto ho postato la quarta soluzione e ho disabilitato gli eventi evitando quindi di richiamare il change
prova e fai sapere
saluti
r

Option Explicit
Dim rngbase
Dim lM As Long
Private Sub Workbook_Open()
rngbase = [foglio1!a1].Value
lM = VBA.Minute(Now)
End Sub
'nel modulo di classe del foglio
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Excel.Range
Dim TuoRng As Excel.Range
Set TuoRng = [foglio1!a1]
If TuoRng.Parent.Name = Sh.Name Then
    If TuoRng.Value <> rngbase Then
        If VBA.Minute(Now) <> lM Then
            Application.EnableEvents = False
            Set rng = A1FoglioLog("FoglioLog")
            rng.Value = TuoRng.Value
            rng.Offset(0, 1) = Environ("username")
            rng.Offset(0, 2) = Now
            rng.Offset(0, 3) = VBA.Year(Now)
            rng.Offset(0, 4) = VBA.Month(Now)
            rng.Offset(0, 5) = VBA.Day(Now)
            rng.Offset(0, 6) = VBA.Hour(Now)
            rng.Offset(0, 7) = VBA.Minute(Now)
            rngbase = TuoRng.Value
            lM = VBA.Minute(Now)
            Application.EnableEvents = True
        End If
    End If
End If
End Sub

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Robi (utente non iscritto) data: 03/04/2009
Ciao roberto,
penso che l'ultima soluzione sia la migliore.

piccolo problema: se ho 2 file, ognuno salvato con una quotazione diversa dall'altro, ogni aggiornamento che avviene nel 1^ viene riportato anche nel 2^ file e viceversa.
è strano perchè all'inizio non lo faceva.
grazie x la tua competenza
di Robi (utente non iscritto) data: 03/04/2009
Ha rimandato per errore lo stesso msg.
poi provo e ti facc sapere.
di Robi (utente non iscritto) data: 03/04/2009
Grande roberto
due o più file aperti sia con aggiornamento a 1 minuto sia in "continua" non si sovrascrivono.
very good!!
di Robi (utente non iscritto) data: 06/04/2009
Ciao roberto, piccolo problema:
se apro un file excel mentro è aperto quello con la macro di cui sopra, il file appena aperto mi dà il messaggio:

"errore run time 424:necessario oggetto"

?
grazie
di Robi (utente non iscritto) data: 06/04/2009
Se poi apro debug, mi evidenzia in giallo sulla macro la riga "set tuorng = [foglio1!a1]"
di R (utente non iscritto) data: 06/04/2009
Sostituisci con
thisworkbook.worksheets("foglio1").range("a1")

saluti
r
di Robi (utente non iscritto) data: 07/04/2009
Errore run time438 :proprietà o metodo non supportati dall'oggetto
grazie

di R (utente non iscritto) data: 07/04/2009
Prova e fai sapere ... devi adattare ai tuoi riferimenti ... dove trovi foglio1 modifica col nome del tuo foglio
fai sapere
saluti
r

Option Explicit
Dim rngbase
Dim lM As Long
Private Sub Workbook_Open()
rngbase = ThisWorkbook. _
    Worksheets("foglio1").Range("A1").Value '< rngbase Then
        If VBA.Minute(Now) <> lM Then
            Application.EnableEvents = False
            Set rng = A1FoglioLog("FoglioLog")
            rng.Value = TuoRng.Value
            rng.Offset(0, 1) = Environ("username")
            rng.Offset(0, 2) = Now
            rng.Offset(0, 3) = VBA.Year(Now)
            rng.Offset(0, 4) = VBA.Month(Now)
            rng.Offset(0, 5) = VBA.Day(Now)
            rng.Offset(0, 6) = VBA.Hour(Now)
            rng.Offset(0, 7) = VBA.Minute(Now)
            rngbase = TuoRng.Value
            lM = VBA.Minute(Now)
            Application.EnableEvents = True
        End If
    End If
End If
End Sub

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Robi (utente non iscritto) data: 07/04/2009
Questa macro risolve il problema ma nn aggiorna il foglio log. al limite tengo questa macro aperta in un file, giusto per non creare questi errori runtime. bah!

di R (utente non iscritto) data: 07/04/2009
Ma no! ... si era mangiato 2 righe ...
prova ... e che sia la volta buona

Option Explicit
Dim rngbase
Dim lM As Long

Private Sub Workbook_Open()
rngbase = ThisWorkbook. _
    Worksheets("foglio1").Range("A1").Value '< rngbase Then
        If VBA.Minute(Now) <> lM Then
            Application.EnableEvents = False
            Set rng = A1FoglioLog("FoglioLog")
            rng.Value = TuoRng.Value
            rng.Offset(0, 1) = Environ("username")
            rng.Offset(0, 2) = Now
            rng.Offset(0, 3) = VBA.Year(Now)
            rng.Offset(0, 4) = VBA.Month(Now)
            rng.Offset(0, 5) = VBA.Day(Now)
            rng.Offset(0, 6) = VBA.Hour(Now)
            rng.Offset(0, 7) = VBA.Minute(Now)
            rngbase = TuoRng.Value
            lM = VBA.Minute(Now)
            Application.EnableEvents = True
        End If
    End If
End If
End Sub

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di R (utente non iscritto) data: 07/04/2009
L'ha fatto ancora sono i simboli di minore che fan leggere all'editor di questo forum come se fosse html ;-( ...
vai con questa!

saluti
r

Option Explicit
Dim rngbase
Dim lM As Long
Private Sub Workbook_Open()
rngbase = ThisWorkbook. _
    Worksheets("foglio1").Range("A1").Value '--adatta ai tuoi riferimenti
lM = VBA.Minute(Now)
End Sub
'nel modulo di classe del foglio
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Excel.Range
Dim TuoRng As Excel.Range
Set TuoRng = ThisWorkbook. _
    Worksheets("foglio1").Range("A1") '--adatta ai tuoi riferimenti
If TuoRng.Parent.Name = Sh.Name Then
    If TuoRng.Value <> rngbase Then
        If VBA.Minute(Now) <> lM Then
            Application.EnableEvents = False
            Set rng = A1FoglioLog("FoglioLog")
            rng.Value = TuoRng.Value
            rng.Offset(0, 1) = Environ("username")
            rng.Offset(0, 2) = Now
            rng.Offset(0, 3) = VBA.Year(Now)
            rng.Offset(0, 4) = VBA.Month(Now)
            rng.Offset(0, 5) = VBA.Day(Now)
            rng.Offset(0, 6) = VBA.Hour(Now)
            rng.Offset(0, 7) = VBA.Minute(Now)
            rngbase = TuoRng.Value
            lM = VBA.Minute(Now)
            Application.EnableEvents = True
        End If
    End If
End If
End Sub

Function A1FoglioLog(sSh As String) As Excel.Range
Dim Sh As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim r As Long
On Error Resume Next
Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(sSh)
If Err Then
    Err.Clear
    Set A1FoglioLog = Wb.Worksheets.Add().Range("A1")
    A1FoglioLog.Parent.Name = sSh
Else
    r = UltimaRiga(Sh) + 1
    If r > Sh.Cells.Rows.Count Then
            Sh.Rows("2:1001").Delete Shift:=xlUp
        r = r - 1000
    End If
    Set A1FoglioLog = Sh.Cells(r, 1)
End If
On Error GoTo 0
End Function

Function UltimaRiga(Optional Sh As Worksheet, _
                 Optional rng As Range) As Long


'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng


    If Sh Is Nothing Then
        If rng Is Nothing Then
            Set rng = [a1].Parent.UsedRange
        End If
    Else
        Set rng = Sh.UsedRange
    End If


    On Error Resume Next
    UltimaRiga = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di R (utente non iscritto) data: 07/04/2009
Ok quest'ultima è completa di tutte le righe ...
di Robi (utente non iscritto) data: 07/04/2009
Bravo roberto! funziona
speriamobene

Vuoi Approfondire?