Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Importare (una) tabella da web

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Importare (una) tabella da web

Postdi Gianca532011 » 27/01/17 11:46

Ciao, ho un problema con l'importazione di una tabella da un sito web, ovvero avevo risolto brillantemente con una query, con la quale scarico i dati ad ogni minuto, quindi in aggiornamento continuo per tutta la durata dell'apertura della Borsa. Si tratta del listino azioni FTSE_MIB . Volendo condividere con un sito di finanza, mi hanno segnalato che la query non funziona, quindi ho cercato di aggirare l'ostacolo con una macro-query, prelevata da questo stesso forum.
La macro funziona ma non riesco a "dirle" di prelevare solo la tabella [0], quindi mi importa tutta la pagina, e poi non si aggiorna.

Allego esempio con query funzionante e il codice di cui sopra.

Codice: Seleziona tutto
 
Sub Macro1()
'
' Macro1 Macro
'
' Scelta rapida da tastiera: CTRL+q
Sheets("Foglio2").Select ' o il nome del tuo foglio
Range("A2:M500").ClearContents ' cancella il contentuto del range Foglio2.Activate

With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://it.investing.com/equities/", Destination:= _
        Range("A2"))
        .Name = "FTSE_MIB"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub]

il file con query funzionante : http://www.filedropper.com/bozza2

Ps. La query è stata impostata con un Power Query scaricato da Microsoft per excel 2013
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Sponsor
 

Re: Importare (una) tabella da web

Postdi Gianca532011 » 27/01/17 12:17

Ovviamente ho gia provato con la procedura : dati , da web, ma anche in questo caso sulla pagina del sito NON ci sono i simboli freccia nera su campo giallo a identificare le varie tabelle: Che sia la [tabella 0] e non altre l'ho vista solo con quel pacchetto integrativo di excel, da cui ho appunto fatto la selezione.
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Anthony47 » 28/01/17 20:12

Nelle pagine con script, quale e' quella da cui vuoi importare, la web query secondo Microsoft non funziona.
Puoi comunque ottenere un risultato valido sostituendo queste righe
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage

con queste:
Codice: Seleziona tutto
        .RefreshPeriod = 1
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "3"


Modifica anche la riga .RefreshOnFileOpen = False inserendo True invece che False

Poi:
Cancella tutto il contenuto della pagina su cui lavori (almeno l'area occupata dai risultati della query); ti segnalera' che e' presente una query memorizzata, tu scegli di eliminare sia la query che il contenuto delle celle.
Poi manda in esecuzione una volta la macro; ti creera' la query memorizzata e importera' i dati.
Da quel momento ogni minuto la query aggiornera' i dati.

Io suggerirei anche di modificare la riga .Refresh BackgroundQuery:=False sostituendo anche qui False con True; questo consentira' l'aggiornamento dei dati in background, mentre con False durante l'aggiornamento il foglio rimane bloccato per alcuni secondi

Tutte le volte che esegui la macro (e non dovrebbe essere necessario eseguirla piu' di una volta) ricordati che e' bene PRIMA andare a cancellare il contenuto della pagina compreso la query precedentemente memorizzata.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17438
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare (una) tabella da web

Postdi Gianca532011 » 29/01/17 21:38

Alla fine ci sono riuscito NI, ovvero la macro fa quello che deve fare , importa cancella i dati inutili etc, tutto
bene se la pagina di riferimento FOSSE STATICA, però nel caso in questione è una pagina di borsa con aggiornamenti dell'ordine di secondi, ora quando la pagina web fa il refresh dati, si aggiorna anche la mia query ma non funzionando sotto macro mi sbrodola dati inutili. E' solo un fatto estetico , ma mi urta non riuscire ad avere una videata ripulita da dati non richiesti. :(

Allego il file, se qualcuno volesse dare un occhio è ben accetto.

http://www.filedropper.com/queryv6
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Anthony47 » 30/01/17 00:26

Non ho capito se hai provato come avevo suggerito e con quali risultati.
Inoltre, per evitare equivoci, dovresti chiarire quali dati della pagina ti interessa scaricare.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17438
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare (una) tabella da web

Postdi Gianca532011 » 31/01/17 18:53

ciao Anthony, allora ho raccolto i tuoi suggerimenti, ma ho anche cambiato filosofia, ovvero scarico l'intera pagina nel foglio1 e da qui faccio copia di quello che mi interessa in foglio2. E fin qui la cosa "sembra" funzionare. Dov'è l'inghippo ? a questo punto mi sono bloccato perchè il foglio 2 non si aggiorna col .refresh della query di fo1. In pratica sto cercando un comando che associato al refreshPeriod, magari ritardato 10 secondi con on time , mi aggiorni anche il foglio 2. Ho trovato soluzionio che funzionano ma solo sotto macro !!! :evil: cosa che non va bene per dati che si aggiornano in tempi di secondi. se hai qualche dritta ... è mooolto ben accetta.

allego codice attuale .
Codice: Seleziona tutto
   
   Sub Prova2()
    Dim oSh As Worksheet
    Dim wSh As Worksheet
        Set oSh = Sheets("Foglio1")
    Set wSh = Sheets("Foglio2")
                 
    oSh.Select
                   
     For Each wq In ActiveSheet.QueryTables
     wq.Delete
     Next wq ' elimina eventuali connessioni
               
         Application.ScreenUpdating = False
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://it.investing.com/equities/", Destination:=Range("a2"))
        .BackgroundQuery = True
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = True
        .RefreshStyle = xlOverwriteCells
        SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 2 'in minuti
        .WebFormatting = None
        '.WebSelectionType = xlSpecifiedTables
        'WebTables = 0
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = False
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .refresh BackgroundQuery:=True
       
       End With
     Application.ScreenUpdating = True
           Call Copia
   Call Cancella
End Sub

Private Sub Copia()
    Set oSh = Foglio1
      Set wSh = Foglio2
       wSh.Select
      Range("a1").Value = "FTSE_MIB"
    wSh.Range("a2:a1000").EntireRow.Clear
oSh.Select
Application.ScreenUpdating = False
Sheets("Foglio1").Select
    Range("B7:I46").Select
    Selection.Copy
    Sheets("Foglio2").Select
    Range("A2").Select
    ActiveSheet.Paste
Range("H2:I42").NumberFormat = "hh:mm:ss"
Range("A1").Select

Application.ScreenUpdating = True
Sheets("Foglio1").Select
Range("A1").Select

End Sub

Private Sub Cancella()
Sheets("Foglio1").Select
Range("a1:a1000").EntireRow.Clear
End Sub
   
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 31/01/17 19:27

Forse ho risolto con : ActiveSheet.Paste Link:=True

Te lo dico domani a mercati aperti . Ciao
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 01/02/17 17:41

Ok, funziona. Ora però ho un altro problema, spiego :

1)attivo la macro e la query mi scarica la pagina web in foglio1 , da qui copio la tabella che mi interessa in foglio 2,
2) qui creo una colonna "testimone" copiando la colonna dei dati di "adesso" prelevata per.es alle 9,00 di mattina.
3) la query ripete il suo ciclo di scarico dati, con refresh automatico, senza più attivare la macro e ogni 2 minuti i dati si aggiornano; eccetto la colonna "testimone", che non voglio fare aggiornare, altrimenti che riferimento sarebbe.

il problema è che voglio inserire un confronto tra la colonna Adesso, che si aggiorna sempre e la colonna "testimone" la difficoltà è che non c'è alcun input utente ma solo un aggiornamento automatico.

Come fare ?? Se fosse un collegamento DDe ho trovato una macro di Anthony che andrebbe bene ma nel mio caso c'è un coll. web non compatibile e non funzia . Come altra soluzione potrei fare riferimento a una colonna con l'ora che sia aggiorna sempre ad ogni variazione dei dati . Ho già preparato delle macro provate e funzionanti ma senza l'interruttore che le attivi non ci faccio niente.
idee , suggerimenti ??
grazie
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Anthony47 » 03/02/17 00:56

Il mio suggerimento e' che provi a sfruttare "After Refresh Event", come suggerito ad altro utente qui:
viewtopic.php?t=98829#p568768

Oppure elimini dalla weq query il refresh ogni 2 minuti e lo sostituisci con una macro OnTime, che scatta ogni 2 minuti ed e contiene qualcosa come
Codice: Seleziona tutto
Sheets("Foglio1").Range("B2").QueryTable.Refresh BackgroundQuery:=True         '<<< Inserire Foglio e Range corretti

SUBITO PRIMA di avviare il refresh farai il confronto con la tabella ombra per le azioni del caso; dico "subito prima" perche' l'opzione BackgroundQuery:=True non ti consente di sapere quando finira' la nuova importazione, mentre l'opzione BackgroundQuery:=False e' inutilizzabile perche' bloccherebbe il pc per vari secondi a ogni refresh.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17438
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare (una) tabella da web

Postdi Gianca532011 » 03/02/17 09:56

Grazie Anthony, su un sito US ho trovato questa macro che sembra funzionare e sposa il tuo concetto di "ombra" anche se crea uno foglio "specchio".

Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim oSh As Worksheet
    Dim wSh As Worksheet
    Dim r As Range
        Set oSh = Worksheet("Foglio1")
    Set wSh = Worksheets("Foglio2")
     oSh.Select
     
     For Each r In Target.Cells
           If r.Value <> Sheet1_Mirror.Range(r.Address).Value Then
                'MsgBox "Value of cell " & " was changed. " & vbCrLf _
                '& "Was: " & vbTab & Sheet1_Mirror.Range(r.Address).Value & vbCrLf _
                '& "Is now: " & vbTab & r.Value
            'Mirror this new value.
            Sheet1_Mirror.Range(r.Address).Value = r.Value
        Else
            'It hasn't really changed. Do nothing.
        End If
    Next
End Sub


se ho ben capito il foglio1 è lo specchio, però non identifica in modo univoco dove copiare, ovvero l'ho provata su un file di soli due fogli e funziona bene, ma se ne avessi tre o quattro di fogli ?Come fare ? :)
Il msg box l'ho tolto perchè non funzionante, probabilmente è previsto per una sola cella, nel mio caso cambia valore circa 40 celle o più.
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 10/02/17 11:10

Sono a buon punto nel mio progetto, ora però ho una domanda alla quale , finora, non sono riuscito a dare risposta , ovvero è possibile bloccare una connessione in modo tale che sia l'unica ad essere utilizzata da una query ?

Nella mia macro query ho inserito il seguente codice, ma a volte mi trovo molteplici connessioni, mentre secondo me una basta e avanza.
Codice: Seleziona tutto
For Each qt In ActiveSheet.QueryTables
     qt.Delete
     Next qt ' elimina eventuali connessioni
           


grazie.
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 10/02/17 12:24

Chiarisco meglio, quando apro il file e automaticamente si attiva la macro-query si ha una connessione multipla e ripetuta, poi, una volta che ha fatto il primo "giro" , tutto si normalizza con un andamento ciclico secondo i tempi prefissati con on time. idee ?
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 11/02/17 17:00

Come non detto , ho risolto modificando le macro on time inserite in WorkBook_open, lunedi faccio un test su dati reali quindi, se Ok, condivido il tutto.
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 15/02/17 11:19

Giusto per non lasciare le cose a metà allego stesura finale del progetto, a futura memoria mia e di altri allego i vari moduli del programma e anche il file finale.

In "questa cartella" :
Codice: Seleziona tutto
Option Explicit

Sub WorkBook_Open()
If TimeValue(Now()) >= "09:00:00" Then
Modulo1.MyQuery  ' attiva "myquery"
End If

If TimeValue(Now()) >= "09:00:10" Then
Modulo4.Avvia  ' attiva macro con timer ogni 2 minuti"
 End If
             
Sheets("foglio1").Visible = False
Sheets("foglio2").Activate

End Sub


in modulo 1 la macro che provvede allo scarico dei dati dal sito con frequenza (modificabile)di 2 minuti:
Codice: Seleziona tutto
Sub MyQuery()
    Dim oSh As Worksheet
    Dim wSh As Worksheet
    Dim qt As QueryTables
   
         Set wSh = Sheets("Foglio2")
       Set oSh = Sheets("Foglio1")
                  Sheets("Foglio1").Activate
                 
   If oSh.QueryTables.Count > 1 Then  'elimina eventuali connessioni
    oSh.QueryTables(2).Delete
  End If
    'qt = "MyQuery"
     'For Each qt In ActiveSheet.QueryTables
    'qt.Delete
    'Next qt
    ' elimina eventuali connessioni
               
         Application.ScreenUpdating = False
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://it.investing.com/equities/", Destination:=oSh.Range("a2"))
        .BackgoundQuery = True
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = True
        .RefreshStyle = xlOverwriteCells
        SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 2 'in minuti
        .WebFormatting = None
        '.WebSelectionType = xlSpecifiedTables
         .WebTables = 3
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = False
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .refresh BackgroundQuery:=True
       
       End With
     Application.ScreenUpdating = True

 Range("a1:K1000").EntireRow.Clear
   'Set wSh = Nothing
   'Set oSh = Nothing
   
   End Sub





in modulo 3 la macro che copia i dati da foglio1 a foglio2 :
Codice: Seleziona tutto
Sub copia()
    'Set oSh = Worksheets("Foglio1")
    Set wSh = Sheets("Foglio2")
       
        Application.ScreenUpdating = False
        Set oSh = Sheets("Foglio1")
                  Sheets("Foglio1").Activate
         
          Range("B2:I42").Select
          Selection.Copy
          Sheets("Foglio2").Select
          Range("A1").Select
          ActiveSheet.Paste
          Application.CutCopyMode = False
   
                                          ' importante la copia dei dati avviene come valori, quindi non Cc'è
                                         ' l'aggiornamento automatico in tabella 2, cosa che avvuiene se si mette
                                          ' PasteLink=true.
                                            'Cosi facendo la copia dei valori- temporizzata-deve essere attuata tramite macro
                                            ' on time vedi macro AVVIO
       

    Range("A1:H1").Interior.ColorIndex = 43
    Range("H2:H42").Select
    Selection.NumberFormat = "h:mm:ss;@" 'Selection.NumberFormat = ora
     
   Application.ScreenUpdating = True
    Range("A2").Select
   
End Sub


in macro 4 la macro che ogni 2 minuti, anche questa modificabile, provvede alla copia e alla minima elaborazione dei dati, ovvero colora le celle con valori > di 0 e < di 0.
Codice: Seleziona tutto
Public mTempo As Date
    Sub Avvia()
        Sheets("Foglio1").Cells(1, 12) = 0
        Ripeti
        End Sub
 
    Private Sub Ripeti()
       
        mTempo = Now + TimeSerial(0, 1, 0)
        Application.OnTime mTempo, "Ripeti"
        volte = 255 ' Serve a fermare l'esecuzione dopo "N" chiamate
        Sheets("Foglio1").Cells(2, 42) = Sheets("Foglio2").Cells(2, 42) + 1
        copia
        Colora1
        Colora2
       
       If Sheets("Foglio1").Cells(1, 12) >= volte Then
                     Call Ferma(mTempo)
         
        End If
             
    End Sub
 
Private Sub Colora1()
    Dim wSh As Worksheet
    Dim lRiga As Long
    Dim lng As Long
    Dim s As String
    Dim myId
    Dim myOldId
Set wSh = Sheets("Foglio2")
wSh.Select
     
       
    For lRiga = 2 To 42 '<<  cambiare numero di righe
    myId = Cells(lRiga, 2).Value  'cambiare da col. 1 alla colonna attuale
    'myOldId = Cells(lRiga, 27).Value ' colonna di riferimento
    'If myId <> myOldId Then
        Range(Cells(lRiga, 2), Cells(lRiga, 2)).Interior.ColorIndex = 36
        'myOldId = myId
    'Else
        'Range(Cells(lRiga, 2), Cells(lRiga, 2)).Interior.ColorIndex = 36
        'myOldId = ""
    'End If
Next lRiga
     
Application.OnTime Now + TimeValue("00:00:15"), "Ripristina" ' ripristina il colore
       
    Set wSh = Nothing
End Sub

Private Sub ripristina()
For lng = 2 To 42
    With Cells(lng, 2)
           .Interior.ColorIndex = 20
       .Font.ColorIndex = 1
       .Font.Bold = False
       .Borders.ColorIndex = 15
    End With
    With Cells(lng, 6)
           .Interior.ColorIndex = 20
       .Font.ColorIndex = 1
       .Font.Bold = False
       .Borders.ColorIndex = 15
    End With
Next lng
End Sub
 
 Private Sub Ferma(mTempo)
        Application.OnTime mTempo, "Ripeti", , False
        MsgBox "Fine Elaborazione"
    End Sub
Public Tempo As Integer
 

altri moduli 5 e 6 accessori. La macro Chiudi e salva è collegata a un bottone .
Codice: Seleziona tutto
Sub Chiudi_Excel()
    ActiveWorkbook.Save
    With Application
        .DisplayAlerts = False
         ActiveWorkbook.Close
        .DisplayAlerts = True
         'Application.Quit
          End With
            'Application.Quit
   End Sub


macro 6 x la una seconda colorazione
Codice: Seleziona tutto
Sub Colora2()
Dim wSh As Worksheet
    Dim lRiga As Long
    Dim myId
Set wSh = Sheets("Foglio2")


For lRiga = 2 To 42 '<<  cambiare numero di righe
    myId = Cells(lRiga, 6).Value  'cambiare colonna  6 =F
    If myId < 0 Then
        Range(Cells(lRiga, 6), Cells(lRiga, 6)).Interior.ColorIndex = 46 'rosso amaranto
           Else
    If myId > 0 Then
   
        Range(Cells(lRiga, 6), Cells(lRiga, 6)).Interior.ColorIndex = 36 'giallo
          End If
          End If
Next lRiga
Application.Wait (Now + TimeValue("0:00:10")) ' tempo di attesa in secondi

Range("F2:f42").Interior.ColorIndex = xlNone  ' cancella colore
End Sub


Il file completo a seguire, prima di fare i miei soliti casini !!!
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 15/02/17 11:22

Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 15/02/17 16:09

ps. C'e un "piccolo" bug che spero qualcuno sappia correggere ;) perche quando la macro"avvia" e cicla per ca 255 volte, ovvero il tempo che intercorre tra le 8,45 alle 17,30 con frequenza due minuti.
Succede che se la si stoppa interrompendo questo ciclo non sempre si riesce a chiudere, a volte mi è successo di dovere chiudere excel bruscamente (Ctrl-alt-canc).
Ci sto lavorando ma non è cosa semplice , almeno per me.

Le macro, prese a sè vanno tutte bene è l'impalcato generale che non è perfetto, ma ci arriveremo. 8)
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 15/02/17 18:42

Sistemato, almeno cosi sembra, ma con " sorpresa "ovvero Il file non si apre più"...al di fuori dell'orario di apertura della borsa, altra cosa quando lo si chiude si esce anche da excel, quindi Occhio :diavolo: ad altri file aperti...

E' possibile aprirlo,tasto destro apri copia, funziona ma x salvarlo selezionare .xlsm, file con macro.


http://www.filedropper.com/webquery11b64
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Anthony47 » 16/02/17 00:51

Avessi usato l'evento AfterRefresh non avresti avuto problemi con macro OnTime di difficile interruzione :D

Comunque vedo che tu correttamente usi la variabile mTempo As Date per tenere traccia dell'orario di prossima schedulazione e lo usi per interrompere la schedulazione gia' impostata. Quindi ti dovrebbe bastare inserire nella macro di Workbook_BeforeClose la deschedulazione ed elimini la .Quit (che immagino hai messo perche' altrimenti entro 1 minuto il file si "risvegliava automaticamente").
Codice: Seleziona tutto
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Ferma(mTempo)
End Sub

Io eliminerei dalla Sub Workbook_BeforeClose anche ThisWorkbook.Save (come ho fatto nel codice soprastante), lasciando all'utente la scelta di salvare o non salvare all'uscita.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17438
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare (una) tabella da web

Postdi Gianca532011 » 18/02/17 11:37

Grazie , ma mi sono impantanato su un altro problema con ciclo for a tre condizioni ,ovvero :

vorrei rendere piu chiara ed elastica la gestione della macro che fa la ripetizione del ciclo di copia dati da fo 1 a fo2 inserendo tre condizioni :
xvolte = numero max di "volte" che si vuole ripetere il ciclo => inserito dall'utente (range K14)
volte = il numero delle ripetizioni l'una dopo l'altra con mTempo definito da Ciclo (range K12)
Ciclo = range k16 - in ui lutente inserisce la frequenza di copia dati ( con macro ontime) => input utente

infine ciclo if che , quando "volte = xvolte" ferma tutto, attiva macro specifica (Ferma(mTempo) e resta in standby

allego pastrocchio che non funzia, la macro incriminata è la "Ripeti", cortesemente se mi spiegate dove è sbagliata :oops: grazie

Codice: Seleziona tutto
Public mTempo As Date, TCiclo As Date

    Private Sub Avvia()
               
        Sheets("Foglio2").Cells(12, 11) = 0
                Ripeti
        End Sub
 
    Private Sub Ripeti()
        Dim volte As Long
        Dim xvolte As Long
        Dim TCiclo As Date
        Dim i As Integer


          volte = Foglio2.Cells(12, 11)
          xvolte = Foglio2.Cells(14, 11) ' Serve a fermare l'esecuzione dopo "N" chiamate
          TCiclo = Foglio2.Cells(16, 11)
         
          Cells(16, 11).Select
    Selection.NumberFormat = "hh:mm:ss;@"
       
          mTempo = Now + TimeValue("00:02:00")
           i = volte = 0
                   
                   For i = i + 1 To xvolte
                   Application.OnTime mTempo, "Ripeti"
                     
        copia
        'Colora1
       'Colora2
       
            Cells(12, 11).Value = i
           ' DisplayNumber (i)
           Next
           If i = xvolte Then
                     Call Ferma(mTempo)
                       End If
              'Exit For
               'Next
                  volte = Cells(11, 11).Value = 0
 
   
        If TimeValue(Now()) > "17:30:00" Then
   Exit Sub
End If
                           
     
    End Sub
 
Private Sub Colora1()
    Dim wSh As Worksheet
    Dim lRiga As Long
    Dim lng As Long
    Dim s As String
    Dim myId
    Dim myOldId
Set wSh = Sheets("Foglio2")
wSh.Select
     
       
    For lRiga = 2 To 42 '<<  cambiare numero di righe
    myId = Cells(lRiga, 2).Value  'cambiare da col. 1 alla colonna attuale
    'myOldId = Cells(lRiga, 27).Value ' colonna di riferimento
    'If myId <> myOldId Then
        Range(Cells(lRiga, 2), Cells(lRiga, 2)).Interior.ColorIndex = 36
        'myOldId = myId
    'Else
        'Range(Cells(lRiga, 2), Cells(lRiga, 2)).Interior.ColorIndex = 36
        'myOldId = ""
    'End If
Next lRiga
     
Application.OnTime Now + TimeValue("00:00:15"), "Ripristina" ' ripristina il colore
       
    Set wSh = Nothing
End Sub

Private Sub ripristina()
For lng = 2 To 42
    With Cells(lng, 2)
           .Interior.ColorIndex = 20
       .Font.ColorIndex = 1
       .Font.Bold = False
       .Borders.ColorIndex = 15
    End With
    With Cells(lng, 6)
           .Interior.ColorIndex = 20
       .Font.ColorIndex = 1
       .Font.Bold = False
       .Borders.ColorIndex = 15
    End With
Next lng
End Sub
 
 Private Sub Ferma(mTempo)
        Application.OnTime mTempo, "Ripeti", , False
        MsgBox "Fine Elaborazione"
    End Sub


 
Sub Colora3()
Dim wSh As Worksheet
    Dim lRiga As Long
    Dim myId
Set wSh = Sheets("Foglio2")


For lRiga = 2 To 42 '<<  cambiare numero di righe
    myId = Cells(lRiga, 2).Value  'cambiare colonna  6 =F
    If myId < 0 Then
        Range(Cells(lRiga, 2), Cells(lRiga, 2)).Interior.ColorIndex = 36 'rosso amaranto
           Else
    If myId > 0 Then
   
        Range(Cells(lRiga, 2), Cells(lRiga, 2)).Interior.ColorIndex = 19 'giallo
          End If
          End If
Next lRiga
Application.Wait (Now + TimeValue("0:00:10")) ' tempo di attesa in secondi

Range("B2:B42").Interior.ColorIndex = xlNone  ' cancella colore
End Sub
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Re: Importare (una) tabella da web

Postdi Gianca532011 » 18/02/17 16:17

Alla fine ho risolto con questa macro che funziona ma ha qualche pecca ovvero ho dovuto inserire un "wait" per farsi che tra una lettura dei dati, con copia da fo1 a foglio 2 , intercorrano due minuti (mTempo) di pausa . Ciò non va bene perchè cosi facendo il PC resta impallato.
Codice: Seleziona tutto
    Private Sub Ripeti()
        Dim volte As Long
       
        mTempo = Now + TimeValue("00:02:00")
       
        volte = Foglio2.[K14] ' Serve a fermare l'esecuzione dopo "N" chiamate
        For volte = 1 To [K14]
       
        Application.OnTime mTempo, "Ripeti", volte
        copia
        Colora1
        Colora2
        Modulo2.test_msgbox_temp_5
       
        'MsgBox "il contatore vale " & volte
             
          Cells(16, 11) = volte
         Application.Wait mTempo
         
                    If Sheets("Foglio2").Cells(14, 11) = volte Then
                     Call Ferma(mTempo)
                       End If
                Next
             
         Cells(16, 11) = 0
        Cells(14, 11) = 0
        If TimeValue(Now()) > "17:30:00" Then
   Exit Sub
End If
                 
     
    End Sub


Nel file qui allegato, al modulo 2 trovate una "chicca ,almeno per me e ovviamente non mia , ovvero una macro che trasmette brevi messaggi che si chiudono da soli , senza alcun intervento dell'operatore .


http://www.filedropper.com/webquery11b642
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 252
Iscritto il: 27/05/11 10:18

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Importare (una) tabella da web":


Chi c’è in linea

Visitano il forum: Nessuno e 29 ospiti