Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

InternetExplorer.Application _!_ Risultati Calcio

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

InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 11/03/14 01:16

Ciao a tutti,

scrivo poche righe per cercare qualcuno che mi venga incontro e mi aiuti a risolvere alcuni problemi:

I problemi sono:

Immagine

1) come si può notare nel foglio " Data " in L10 ed M10
i risultati di calcio mi compaiono con i giorni e i mesi... in formato data... come posso formattarli automaticamente tale da avere i numeri dei goal ?

2) come evitare la formattazione RTF
con " InternetExplorer.Application " ?

Nota Bene: se formatto le righe delle colonne L ed M in formato testo alcune mi compaiono come risultati ? - ? altre mi compaiono sotto forma di 5 cifre ( ossia data )



- Allego la cartella di lavoro " Now... To Set"

NowGoal ToSet.xlsm

1) In questa cartella di lavoro c'è una macro "ImpWebTbl" scritta con " InternetExplorer.Application " :

Codice: Seleziona tutto
Sub ImpWebTbl()
Dim mIE As Object
Dim mTables, mTable
Dim mRows, mRow
Dim mCells, mCell
Dim mRiga As Long, mColonna As Long
Dim k1 As Integer, n As Integer
On Error GoTo Errori

Worksheets("Data").Select
'controlli
n = 1 ' tbl da importare se presente

mRiga = 8 'inizio scrittura tabella
k1 = 0
Set mIE = CreateObject("InternetExplorer.Application")
With mIE
    .AddressBar = False
    .StatusBar = False
    .MenuBar = False
    .Toolbar = 0
    .Visible = False
    .navigate "http://data.nowgoal.com/1x2/bet007history.htm?id=&company=&matchdate=" & [AA2] & "-" & [AA3] & "-" & [AA4]
End With
 
While mIE.Busy
Wend
While mIE.document.readyState <> "complete"
Wend
 
Set mTables = mIE.document.all.tags("TABLE")
With mTables
    For Each mTable In mTables
        k1 = k1   1
        With Range(Cells(mRiga - 2, 1), Cells(mRiga - 2, 1))
        .Value = "Table: " & k1
        .Interior.ColorIndex = 37
        .Font.Bold = True
        End With
       
        If Range("D3") <> "" Then k1 = n
        Set mRows = mTable.Rows
        For Each mRow In mRows
            Set mCells = mRow.Cells
           
            nCol = mCells.Length
            If PreNCol > nCol Then
                mColonna = PreNCol - nCol - 1
            Else
                mColonna = 1
            End If
            For Each mCell In mCells
                ActiveSheet.Cells(mRiga, mColonna) = mCell.innerText
                mColonna = mColonna   1
            Next mCell
            PreNCol = nCol
            mRiga = mRiga   1
        Next mRow
        If n <> 0 And k1 = n Then GoTo Uscita
        mRiga = mRiga   3
    Next mTable
End With

   
Uscita:
  Set mCell = Nothing
  Set mCells = Nothing
  Set mRow = Nothing
  Set mRows = Nothing
  Set mTable = Nothing
  Set mTables = Nothing
  mIE.Quit
  Set mIE = Nothing
 
   Sheets("Data").Select
   Range("L6").Select
   Selection.Copy
   Sheets("ToBet").Select
   Range("Av1:av177").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
   Sheets("Data").Select
   Range("L6").Select
   Selection.Copy
   Sheets("ToBet").Select
   Range("b1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
   Sheets("ToBet").Select
   Range("b2").Select
Exit Sub
Errori:
  MsgBox Err.Number & "-" & Err.Description
  Resume Uscita
    Columns("B:B").Select
    Selection.ColumnWidth = 10.67
    Selection.ColumnWidth = 12.67
    Selection.ColumnWidth = 16
    Columns("K:K").Select
    Selection.ColumnWidth = 17.44
    Selection.ColumnWidth = 21.56
    Range("A6").Select
   
End Sub


Come si noterà nel file allegato nel foglio "Data"... in AA1 ho la cella di controllo con la data corrispondente a quella dell url da cui scarico i dati:

http://data.nowgoal.com/1x2/bet007history.htm?id=&company=&matchdate=2004-12-01


Spero vivamente che qualcuno mi aiuti di Cuore!!!

Ringrazio in anticipo chi verrà incontro al mio rompicapo...

A presto,

Frank.
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Sponsor
 

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi Anthony47 » 11/03/14 12:53

Per evitare il fattaccio devi formattare le celle che saranno popolate dalla macro come "Testo".

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 11/03/14 15:05

Ciao anthony,

grazie del tuo intervento, ho seguito il tuo consiglio.

Ho settato le celle di interesse con formattazione testo... ma non si risolve uniformemente quanto cerco.

Ho messo su questa macro:

Codice: Seleziona tutto
Sub Formato_Risultati_Colonne_L_ed_M()
'
' Formato_Risultati_Colonne_L_ed_M Macro
'

'
    Sheets("Data").Select
    Range("L10:M2000").Select
    Selection.NumberFormat = "@"
End Sub


La richiamo in questa nuova macro:

Codice: Seleziona tutto
Sub ImpWebTbl()
Dim mIE As Object
Dim mTables, mTable
Dim mRows, mRow
Dim mCells, mCell
Dim mRiga As Long, mColonna As Long
Dim k1 As Integer, n As Integer
On Error GoTo Errori

Worksheets("Data").Select
'controlli
n = 1 ' tbl da importare se presente

mRiga = 8 'inizio scrittura tabella
k1 = 0
Set mIE = CreateObject("InternetExplorer.Application")
With mIE
    .AddressBar = False
    .StatusBar = False
    .MenuBar = False
    .Toolbar = 0
    .Visible = False
    .navigate "http://data.nowgoal.com/1x2/bet007history.htm?id=&company=&matchdate=" & [AA2] & "-" & [AA3] & "-" & [AA4]
End With

Call Formato_Risultati_Colonne_L_ed_M

While mIE.Busy
Wend
While mIE.document.readyState <> "complete"
Wend
 
Set mTables = mIE.document.all.tags("TABLE")
With mTables
    For Each mTable In mTables
        k1 = k1 + 1
        With Range(Cells(mRiga - 2, 1), Cells(mRiga - 2, 1))
        .Value = "Table: " & k1
        .Interior.ColorIndex = 37
        .Font.Bold = True
        End With
       
        If Range("D3") <> "" Then k1 = n
        Set mRows = mTable.Rows
        For Each mRow In mRows
            Set mCells = mRow.Cells
           
            nCol = mCells.Length
            If PreNCol > nCol Then
                mColonna = PreNCol - nCol - 1
            Else
                mColonna = 1
            End If
            For Each mCell In mCells
                ActiveSheet.Cells(mRiga, mColonna) = mCell.innerText
                mColonna = mColonna + 1
            Next mCell
            PreNCol = nCol
            mRiga = mRiga + 1
        Next mRow
        If n <> 0 And k1 = n Then GoTo Uscita
        mRiga = mRiga + 3
    Next mTable
End With

   
Uscita:
  Set mCell = Nothing
  Set mCells = Nothing
  Set mRow = Nothing
  Set mRows = Nothing
  Set mTable = Nothing
  Set mTables = Nothing
  mIE.Quit
  Set mIE = Nothing
 
   Sheets("Data").Select
   Range("L6").Select
   Selection.Copy
   Sheets("ToBet").Select
   Range("Av1:av1367").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
   Sheets("Data").Select
   Range("L6").Select
   Selection.Copy
   Sheets("ToBet").Select
   Range("b1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
   Sheets("ToBet").Select
   Range("b2").Select
Exit Sub
Errori:
  MsgBox Err.Number & "-" & Err.Description
  Resume Uscita
    Columns("B:B").Select
    Selection.ColumnWidth = 10.67
    Selection.ColumnWidth = 12.67
    Selection.ColumnWidth = 16
    Columns("K:K").Select
    Selection.ColumnWidth = 17.44
    Selection.ColumnWidth = 21.56
    Range("A6").Select
   
End Sub



Aggirono i dati e mi si presentano alcune righe coi risultati in formato corretto " x - x " ...

altre invece sotto forma di codice numerico " data " .... evidenziate nell' immagine in verde acido...

http://i60.tinypic.com/2lk91lz.jpg

Immagine

Allego il file... NowGoal ToSet.xlsm
se te o chiunque altro di buonavolontà voglia mettere mano al file e alle macro...

grazie in anticipo

a Te, Anthony

e a chi interverrà con info consigli o apporterà migliorie a quanto cerco di risolvere.

buona giornata.

frank.
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi Anthony47 » 12/03/14 00:04

Mi spiace, ma la macro inserita nel file scarica una sola tabella (l' unica presente a quell' url), che finisce in riga 28/29 (Tottenham Hotspur); le righe presunte errate sono successive, non so a quale sorgente html si riferiscono quindi non sono in grado di fare nessuna congettura.

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 18/03/14 13:51

Ciao anthony,

grazie dello spunto, mediante codificazione vba sono riuscito ad ottenere quanto desideravo.

Ora... ( per mettere su automaticamente un archivio ) ... ho bisogno che ripeti una macro al variare di una " data presente nell url " di mio interesse, dove " questa data " fa riferimento a delle celle di "controllo_avanzamento_data" presenti nel foglio e concatenate all'url nel codice vba...

Ho cercato nel forum e vedendo alcuni codici, questi non si attengono alle mie impostazioni.

E' possibile questa soluzione???

Vada che io sia Off Topic come da Titolo... sposterò la discussione.

grazie in anticipo,

buona giornata.

frank
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi Anthony47 » 18/03/14 16:04

Ti ricordo che la filosofia di qualsiasi forum e' condividere le soluzioni, quindi sarebbe corretto che spiegassi con quale "codificazione vba" hai risolto.

Immagino che vuoi ripetere la macro quando cambi "una data sul tuo foglio di lavoro", data che poi viene considerata nel calcolo dell' url di destinazione.
Per questo userai una macro di WorkSheet_Change, del tipo:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$1" Then      '<<< ipotesi che la data do sondare sia in H1
    Call LaTuaMacro
End If
End Sub

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 18/03/14 16:46

Ciao anthony,

mi scuso nel non aver pensato di postarla la soluzione... figurati se non fosse piacere mio condividere.

In parole spicciole sono andato a scindere le formattazioni delle righe pari e delle righe dispari... delle colonne di mio interesse:

Righe pari formato "Numero"
Righe dispari formato "Generale"

Codice: Seleziona tutto
Sub Righe_Dispari_L()
righe = Sheets("ToBet").UsedRange.Rows.Count + Sheets("ToBet").UsedRange.Range("a1").Row
For I = 1199 To 11 Step -2
Cells(I, 12).Select
Selection.NumberFormat = "@"
Next I
End Sub

Sub Righe_Pari_L()

righe = Sheets("ToBet").UsedRange.Rows.Count + Sheets("ToBet").UsedRange.Range("a1").Row
For I = 1200 To 10 Step -2
Cells(I, 12).Select
Selection.NumberFormat = "@"
Next I
End Sub

Sub Righe_Pari_M()
righe = Sheets("ToBet").UsedRange.Rows.Count + Sheets("ToBet").UsedRange.Range("a1").Row
For I = 1200 To 10 Step -2
Cells(I, 13).Select
Selection.NumberFormat = "@"
Next I
End Sub


Cosi nell' immagine:

Immagine

Credo si sia RISOLTO. http://it.tinypic.com/view.php?pic=oiaefo&s=8#.UyhrpYVW_dc
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 18/03/14 17:18

Riguardo all' automazione dell' aggiornamento dell' archivio da una data di partenza presente sotto forma di url in:

Codice: Seleziona tutto
.Navigate "http://data.nowgoal.com/1x2/companyhistory.aspx?id=110&company=SNAI&matchdate=" & [EL2] & "-" & [EL3] & "-" & [EL4]


dove:

EL2 = ANNO EL3 = MESE EL4 = GIORNO

Immagine
http://i62.tinypic.com/2ll1ssw.jpg

Senza stare a ripetere sempre manualmente

Codice: Seleziona tutto
Sub Aggiorna_Archivio()
'
' Aggiorna_Archivio Macro
'

Call Importa_Dati
Call Copia_In_Archivio

'
   
End Sub


con il cambio data e l'esecuzione di queste seguenti macro



Codice: Seleziona tutto
Sub Importa_Dati()
Dim mIE As Object
Dim mTables, mTable
Dim mRows, mRow
Dim mCells, mCell
Dim mRiga As Long, mColonna As Long
Dim k1 As Integer, n As Integer
On Error GoTo Errori


Application.ScreenUpdating = False


Worksheets("ToBet").Select



Call clear_results
Call Righe_Dispari_L
Call Righe_Pari_L


'controlli
n = 1 ' tbl da importare se presente

mRiga = 8 'inizio scrittura tabella
k1 = 0
Set mIE = CreateObject("InternetExplorer.Application")
With mIE
    .AddressBar = False
    .StatusBar = False
    .MenuBar = False
    .Toolbar = 0
    .Visible = False
    .Navigate "http://data.nowgoal.com/1x2/companyhistory.aspx?id=110&company=SNAI&matchdate=" & [EL2] & "-" & [EL3] & "-" & [EL4]
End With

While mIE.Busy Or mIE.READYSTATE <> 4
    DoEvents
Wend
 
Set mTables = mIE.document.all.tags("TABLE")
With mTables
    For Each mTable In mTables
        k1 = k1 + 1
        With Range(Cells(mRiga - 2, 1), Cells(mRiga - 2, 1))
        .Value = "Table: " & k1
        .Interior.ColorIndex = 37
        .Font.Bold = True
        End With
       
        If Range("D3") <> "" Then k1 = n
        Set mRows = mTable.Rows
        For Each mRow In mRows
            Set mCells = mRow.Cells
           
            nCol = mCells.Length
            If PreNCol > nCol Then
                mColonna = PreNCol - nCol - 1
            Else
                mColonna = 1
            End If
            For Each mCell In mCells
                ActiveSheet.Cells(mRiga, mColonna) = mCell.innerText
                mColonna = mColonna + 1
            Next mCell
            PreNCol = nCol
            mRiga = mRiga + 1
        Next mRow
        If n <> 0 And k1 = n Then GoTo Uscita
        mRiga = mRiga + 3
    Next mTable
End With

Sheets("ToBet").Select
Range("BU2").Select

   
Uscita:
  Set mCell = Nothing
  Set mCells = Nothing
  Set mRow = Nothing
  Set mRows = Nothing
  Set mTable = Nothing
  Set mTables = Nothing
  mIE.Quit
  Set mIE = Nothing
 
   
Exit Sub
Errori:
  MsgBox Err.Number & "-" & Err.Description
  Resume Uscita
    Columns("B:B").Select
    Selection.ColumnWidth = 10.67
    Selection.ColumnWidth = 12.67
    Selection.ColumnWidth = 16
    Columns("K:K").Select
    Selection.ColumnWidth = 17.44
    Selection.ColumnWidth = 21.56
    Range("A6").Select
   
   
End Sub

Sub Copia_In_Archivio()

Application.ScreenUpdating = False

Sheets("ToBet").Select

Range("BU2:EJ" & [EP1]).Copy
Sheets("Archivio").Select

'posiziona prima cella libera

With Worksheets("Archivio")
Dim lRiga As Long
lRiga = .Range("C" & Rows.Count).End(xlUp).Row
.Cells(lRiga + 1, 1).Select
End With

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
 xlNone, SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 
Sheets("ToBet").Select
Range("EO1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("EO1").Select
Sheets("ToBet").Select
Range("BU2").Select



End Sub


E' possibile che io riempia l' archivio automaticamnete lasciando lavorare il foglio di lavoro senza che io c metta mano durante il processo e non debba stare a cambiare date ed eseguire sistematicamente il tutto mediante pulsanti ???


grazie della fattiva collaborazione,

a presto anthony.

buona serata

rilascio il file : NowGoal Snai.xlsm
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi Anthony47 » 25/03/14 02:26

In attesa che qualcun altro che abbia la stessa passione utilizzi il tuo file, ne capisca la logica e maturi in lui la voglia di darti una mano, ti chiedo:
-il tuo desiderio e' di avviare la Sub Aggiorna_Archivio quando modifichi la data scritta in qualche cella? Se Si, allora dovrebbe tornare utile quanto suggerito qui: viewtopic.php?f=26&t=101500#p587483
Se "No", allora dovresti spiegare quale macro vuoi far partire e in quale circostanza.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 25/03/14 02:52

Ciao Anthony,

grazie per avermi risposto.

In pratica vorrei che automaticamete mi si scaricassero le gare e che queste venissero archiviate. ( Sub_Aggiorna_Archivio )

Automaticamente, partendo da una data, vorrei che questa cambi da se... in un range di date che parte dal 10/10/1800 x esempio e finisca a ieri 24/03/2014....

la data è posta nel foglio ToBet in BW1...


Buona notte anthony,

attendo tue notizie..

frank
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi Anthony47 » 25/03/14 23:10

Allora...
Inserisci in BW1 la data di inizio della ricerca

Aggiungi in testa al modulo standard che contiene gia' la Sub Aggiorna_Archivio questo codice
Codice: Seleziona tutto
Dim mIE As Object    'QUESTA IN TESTA A UN MODULO

Sub upData()
Do
    Call Aggiorna_Archivio
    DoEvents
    Sheets("ToBet").Range("BW1") = Sheets("ToBet").Range("BW1") + 1
    If Sheets("ToBet").Range("BW1") > Now Then Exit Do
Loop
'istruzioni da togliere nella Importa_Dati:
  Set mCell = Nothing
  Set mCells = Nothing
  Set mRow = Nothing
  Set mRows = Nothing
  Set mTable = Nothing
  Set mTables = Nothing
  mIE.Quit
  Set mIE = Nothing
End Sub

Elimina dalla Importa_Dati la Dim mIE As Object, e le istruzioni che trovi ora in coda alla macro UpData (dopo l' etichetta "Uscita:" che lascerai)

Sostituisci anche Set mIE = CreateObject("InternetExplorer.Application") con
Codice: Seleziona tutto
If mIE Is Nothing then Set mIE = CreateObject("InternetExplorer.Application")


Per prova imposta la data di qualche giorno fa, poi lancia la nuova macro upData e se sei particolarmente fortunato funzionera' tutto; se sei nella media allora dimmi quali errori nascono e su quali istruzioni...

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi FrankieBue » 25/03/14 23:52

Ciao anthony ho eseguito quanto mi hai suggerito,

grazie per avermi risposto...

ma quanto ho eseguito non si mette in pratica... ho una continua schermata bianca...

quando te dici :

Allora...
Inserisci in BW1 la data di inizio della ricerca


io ho in BW1 il numero che mi fornisce la data vera e propria in BU1...

al variare di BW1 varia BU1...

ora ecco il codice:


Codice: Seleziona tutto
Dim mIE As Object    'QUESTA IN TESTA A UN MODULO

Sub upData()
Do
    Call Aggiorna_Archivio
    DoEvents
    Sheets("ToBet").Range("BW1") = Sheets("ToBet").Range("BW1") + 1
    If Sheets("ToBet").Range("BW1") >= Now Then Exit Do
Loop
'istruzioni da togliere nella Importa_Dati:
  Set mCell = Nothing
  Set mCells = Nothing
  Set mRow = Nothing
  Set mRows = Nothing
  Set mTable = Nothing
  Set mTables = Nothing
  mIE.Quit
  Set mIE = Nothing
End Sub

Sub Aggiorna_Archivio()
'
' Aggiorna_Archivio Macro
'

Call Importa_Dati
Call Copia_In_Archivio

'
   
End Sub


Sub Importa_Dati()
Dim mTables, mTable
Dim mRows, mRow
Dim mCells, mCell
Dim mRiga As Long, mColonna As Long
Dim k1 As Integer, n As Integer
On Error GoTo Errori


Application.ScreenUpdating = False


Worksheets("ToBet").Select



Call clear_results
Call Righe_Dispari_L
Call Righe_Pari_L


'controlli
n = 1 ' tbl da importare se presente

mRiga = 8 'inizio scrittura tabella
k1 = 0
If mIE Is Nothing Then Set mIE = CreateObject("InternetExplorer.Application")
With mIE
    .AddressBar = False
    .StatusBar = False
    .MenuBar = False
    .Toolbar = 0
    .Visible = False
    .Navigate "http://data.nowgoal.com/1x2/companyhistory.aspx?id=680&company=Stanleybet&matchdate=" & [EL2] & "-" & [EL3] & "-" & [EL4]
End With

While mIE.Busy Or mIE.READYSTATE <> 4
    DoEvents
Wend
 
Set mTables = mIE.document.all.tags("TABLE")
With mTables
    For Each mTable In mTables
        k1 = k1 + 1
        With Range(Cells(mRiga - 2, 1), Cells(mRiga - 2, 1))
        .Value = "Table: " & k1
        .Interior.ColorIndex = 37
        .Font.Bold = True
        End With
       
        If Range("D3") <> "" Then k1 = n
        Set mRows = mTable.Rows
        For Each mRow In mRows
            Set mCells = mRow.Cells
           
            nCol = mCells.Length
            If PreNCol > nCol Then
                mColonna = PreNCol - nCol - 1
            Else
                mColonna = 1
            End If
            For Each mCell In mCells
                ActiveSheet.Cells(mRiga, mColonna) = mCell.innerText
                mColonna = mColonna + 1
            Next mCell
            PreNCol = nCol
            mRiga = mRiga + 1
        Next mRow
        If n <> 0 And k1 = n Then GoTo Uscita
        mRiga = mRiga + 3
    Next mTable
End With

Sheets("ToBet").Select
Range("BU2").Select

   
Uscita:
 
 
   
Exit Sub
Errori:
  MsgBox Err.Number & "-" & Err.Description
  Resume Uscita
    Columns("B:B").Select
    Selection.ColumnWidth = 10.67
    Selection.ColumnWidth = 12.67
    Selection.ColumnWidth = 16
    Columns("K:K").Select
    Selection.ColumnWidth = 17.44
    Selection.ColumnWidth = 21.56
    Range("A6").Select
   
   
End Sub



dimmi te cosa devo fare ora e se ho sbagliato qualcosa...


grazie della collaborazione.

buonanotte anthony.

ciao
EXCEL 2010
FrankieBue
Utente Junior
 
Post: 24
Iscritto il: 20/01/14 12:23

Re: InternetExplorer.Application _!_ Risultati Calcio

Postdi Anthony47 » 26/03/14 02:21

Codice: Seleziona tutto
dimmi te cosa devo fare ora e se ho sbagliato qualcosa...
Hai sbagliato a dire che in BW1 c' e' la data...
Visto che c' e' un indice farai un collaudo partendo da BW1=3400, che corrisponde alla data 23-marzo-2014; visto che la vera data e' disponibile in lettura in BU1 modificheri l' istruzione If Sheets("ToBet").Range("BW1") >= Now Then Exit Do in
Codice: Seleziona tutto
If Sheets("ToBet").Range("BU1") >= Now Then Exit Do

Poi lanci la macro e vale quello che ho detto al messaggio precedente.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13891
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "InternetExplorer.Application _!_ Risultati Calcio":


Chi c’è in linea

Visitano il forum: Nessuno e 8 ospiti