Oroscopo Modificato ma da mettere q posto

[Maury170419]

Ciao a Tutti non con poca difficoltà sono riuscito a mettere in piedi il Vostro Aiuto iniziale del L'oroscopo.
Ora diciamo che per certi versi Funziona bene tranne che per un fatto strano ; Cioè : Che ad ogni stesura dell'oroscopo scelto in base al nome del segno zodiacale scelto ; mi compaiono dei simboli che non hanno nulla a che fare con l'oroscopo.
Per qui chi di voi se la sentirebbe di darmi una mano per risolvere il tutto.
I Segni in questione sono quelli che appaiono nell'immagine :
[img][img]https://s4.postimg.org/9fv6g5bhl/Oroscopo_2.jpg[/img][/img]

In più sempre a vostra discrezione : Vorrei far apparire prima del nome del Segno Zodiacale anche la Data dei mesi in questione inerente cioè al proprio segno Zodiacale.
Grazie infinite per tutto L'aiuto che vorrete darmi in merito Saluti sinceri da A.Maurizio

(P.S) Il link per scaricare il tutto e questo :
https://app.box.com/s/vge3uubiza4s3651od7p1g5fkg879l5j

[Anthony47]

Quei caratteri strani sono la codifica html di caratteri non standard, quali quelli accentati; li vedi perche' il testo lo prelevi direttamente dal sorgente senza farlo elaborare dal browser (che sa come convertirli).

Ti avevo gia' dato una funzione Oroscopo che estraeva gli oroscopi dal sito donnad.it (vedi viewtopic.php?f=26&t=99714) usando appunto il parsing tramite moduli InternetExplorer.
Nel frattempo il tracciato html di quel sito e' cambiato, immagino che hai smesso di usarla (la vecchia funzione) per questo motivo.

Vedo comunque che ora preferisci estrarre gli oroscopo da oggi.it; quindi ho adattato l'idea della vecchia funzione al nuovo sito, ottenendo questo codice:

Codice: Seleziona tutto

Function Oroscopo2(ByVal Segno As Variant) As String
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=99714
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=108508
'
Dim myColl As Object, myTag, myBase As String, IE As Object, my2Coll As Object
Dim OldD As Long
'
On Error GoTo exitA
myBase = "http://www.oggi.it/oroscopo/oroscopo-di-oggi/"
'
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
'
'Debug.Print "Start: ", Timer
aSegni = Split("Ariete Toro Gemelli Cancro Leone Vergine Bilancia Scorpione Sagittario Capricorno Acquario Pesci")
If IsNumeric(Segno) Then Segno = aSegni(Segno - 1)
Segno = Application.WorksheetFunction.Proper(Segno)
myurl = myBase & Segno & "-oggi.shtml"
With IE
    .Visible = False
    .navigate myurl
    'Debug.Print Timer
    Do While .Busy: DoEvents: Loop  'attesa not busy
    'Debug.Print "NotBusy: ", Timer
    mytim = Timer
    Do Until .readyState = 4        'attesa Document complete
     DoEvents
     If Abs(Timer - mytim) > 2 Then
        'Debug.Print "T.O.: ", Timer
        If IE.document.getElementsByTagName("div").Length = OldD And OldD > 100 Then
            Exit Do
        Else
            OldD = IE.document.getElementsByTagName("div").Length
            'Debug.Print Format(Timer - mytim, "0.0"), OldD, Timer
            mytim = Timer
        End If
     End If
     Loop
End With
'Debug.Print "Usciti: ", IE.document.getElementsByTagName("div").Length, Timer
'
Set myColl = IE.document.getElementsByTagName("div")
For Each myTag In myColl
    If myTag.className = "clearfix rimmed" Then
        Set my2Coll = myTag.getElementsByTagName("p")
        For I = 0 To my2Coll.Length - 1
            mit = mit & my2Coll(I).innerText & vbCrLf
        Next I
        Oroscopo2 = UCase(Segno) & vbCrLf & Trim(Replace(mit, Chr(160), " ", , , vbTextCompare))
        Exit For
    End If
Next myTag
exitA:
IE.Quit
Set IE = Nothing
Set myColl = Nothing: Set my2Coll = Nothing
End Function


Ci sono numerose righe tipo Debug.Print che mi son servite per misurare i tempi; ora sono commentate e possono anche essere eliminate.

Per leggere l'oroscopo potrai usare in D2 la formula

Codice: Seleziona tutto

=Oroscopo2(E1)


In questo modo quando in E1 scegli il segno l'oroscopo sara' ricalcolato e mostrato in D2
La funzione accetta anche un Numero come parametro, dove 1=Ariete e gli altri segni a seguire.

Non ho capito la richiesta fatta a noi di far comparire anche la data cui un certo segno corrisponde: devi solo preparare una tabella con in colonna 1 il segno e in colonna 2 le date corrispondenti; quindi userai Cerca.Vert per estrarre la data giusta e visualizzarla; esempio, in F1:

Codice: Seleziona tutto

=CERCA.VERT(E1;LaTabella;2;0)


Ciao

[Maury170419]

Ciao Anthony come sempre ti devo dire grazie per la tua disponibilità.
Però questa volta hai Toppato, perché pur facendo come mi hai suggerito tu , se io vado apremere il tasto visualizza Oroscopo .
Esso non solo mi apre una pagina Internet con su scrutto (-Embedding) Nessun Risultato.
In più dopo aver fatto questo il programma si Incanta per circa un minuto e più , copo mi colpare MSGBox del sistema dicendomi che c'è un Debug , dopo di ché se io premo il tasto fammi vedere dove : esso mi sottolinea in Giallo questo codice (IE.Quit) con la scritta "Variabile Oggetto o Variabile del Blocco With non Impostata.
Per il resto penso che possa andare bene visto che per il momento non mi da altri Errori.
Perché crea tutto ciò ?
Saluti sinceri da A.Maurizio.
(P.S) Poi per quanto riguardavano le date : Posso anche fare come hai detto tu, Però quando Tu - Flash - e Scossa nella mia prima richiesta mi avevate dato il Vostro supporto tecnico oltre che pratico.
Nel costrutto di Scossa oltre all'oroscopo veniva menzionato sia il Segno zodiacale , che la data corrispondente a tale segno scelto .
tutto qui .

[Anthony47]

Ma io ti ho dato la funzione con cui ottenere l'oroscopo in D2, con formula, sulla base del segno scelto in E1, senza premere nessun pulsante...
Se vuoi realizzare una interfaccia diversa lo devi fare in modo autonomo; ma sinceramente perche' prima scegliere il segno (con l'elenco a discesa in E1) e poi chiedere Calcola l'oroscopo (con l'Ovale1), se puoi ottenere l'oroscopo direttamente quando scegli il segno?
Comunque se vuoi fare il doppio giro allora, dopo aver inserito la Function Oroscopo2, modifica in Sub Ovale1_Click, la riga Foglio1.Range("D2").Value = "" & Oroscopo(vSegno) in

Codice: Seleziona tutto

Foglio1.Range("D2").Value = "" & Oroscopo2(vSegno)

Se ti va bene farlo con formula allora metti la formula in D2 e cancella i due ovali e tutte le macro eccetto la Function Oroscopo2.
Quanto alla data, nel sito oggi.it che usi compare la data odierna, non quella a cui il segno e' associato. Quindi se serve va creata la tabella di conversione; anche se sono sicuro che uno che guarda l'oroscopo sa bene quale e' il segno che gli interessa.

Ciao

[Maury170419]

Ciao Anthony ascolta : Io non sarò sicuramente alla tua altezza in questo campo , però quando tu ho altre persone mi danno dei consigli o degli aiuti concreti , non solo io li prendo per buoni , ma nè faccio anche un enorme bagaglio culturale; Solo cosi Io penso che si possa crescere partemdo da zero come ho fatto Io.
Per qui Io non voglio assolutamente farti Arrabbiare sopratutto per queste cose che dovrebbero al di la di tutto essere considerati dei Divertimenti Personali.
Detto questo : Non solo ti ringrazio nuovamente in Anticito come sempre per il tuo Tempo che dedichi a me ; Però ti consiglio di dare un occhiata al mio progetto che puoi scaricare da questo link :
https://app.box.com/s/vge3uubiza4s3651od7p1g5fkg879l5j

In quanto potrai renderti conto di persona che :

1 ) Non solo continua a darmi errore a questa voce "IE.Quit" Pur facendo come hai detto tu .
2 ) Continua ad Aprirmi una pagina Internet ad ogni segno Zodiacale da me scelto , senza per altro darmi nulla di Indicativo.
3 ) il programma si blocca per qualche Secondo se disattivo questo Codice : (IE.Quit) in questo modo ( ' IE.Quit ) in caso contrario il tutto resta anche bloccato per circa un minuto , come ti avevo già accennato nel Posto precedente tutto qui .

(P.S) Premetto che sicuramente troverai anche L'odiato (On error resume next) che da una tua precedente spiegazione ho potuto toccare con mano che cosa faccia realmente , per qui ti posso garantire che non lo stò più usando da nessuna parte.
Però in questo ho voluto provare di nuovo ad inserirlo per vedere sé fosse riuscito almeno lui a bloccare il tutto dandomi la possibilità di andare oltre al semplice blocco del programma tutto qui .

Grazie Infinite come sempre Sinceri Saluti da A.Maurizio

[Anthony47]

Io ti ho proposto 2 vie:
-in D2 la formula =Oroscopo2(E1)
oppure
-modificare la Sub Ovale1_Click inserendo Foglio1.Range("D2").Value = "" & Oroscopo2(vSegno)

Tu hai scelto di inventarne una terza:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Foglio1.Range("D2").Value = "" & Oroscopo2(E1)
End Sub


Questa soluzione ha lo svantaggio che avvia la lettura dell'oroscopo (operazione che dovrebbe durare qualche secondo) tutte le volte che si cambia selezione sul foglio di lavoro; inoltre, essendo la VARIABILE "E1" vuota, non viene avviata nessuna lettura. Corregendo la riga Foglio1.Range("D2").Value = "" & Oroscopo2(E1) in

Codice: Seleziona tutto

Foglio1.Range("D2").Value = "" & Oroscopo2(Range("E1"))

funzionerebbe anche questa terza soluzione, salvo l'handicap (grave) che parte il ricalcolo a ogni cambio di selezione.

Quanto al fatto che ti restituisce un errore su IE.Quit non so valutarlo; come pure la sessione IE viene creata ma dovrebbe rimanere non visibile (.Visible = False). Queste due situazioni insieme mi portano a pensare che ci sia qualcosa di errato sul tuo pc legato all'installazione di InternetExplorer, per cui ti suggerisco di:
- eliminare la macro di Worksheet_SelectionChange
- usare in D2 la formula =Oroscopo2(E1)
- provare su altro pc

Ciao

[Maury170419]

Ciao Anthony non sono riuscito a risolvere il Problema per qui va bene cosi !
Ti ringrazio infinitamente per il tuo Impegno e per la tua pazienza che rivolgi sempre nei miei confronti .
Una cosa però sono riuscito ad Abozzare e funziona alla grande, ed è questa : Seguendo un pochino il tuo ragionamento
sono riuscito a far comparire in una cella la (D14) le suddette date immetendo questo codice al suo Interno che è questo :
=SE.ERRORE(CERCA.VERT(E1;'Base Appoggio'!A:B;2;FALSO);"")
In pratica funziona cosi : quando in (E1) del foglio1 scelgo il segno zodiacale , viene trovata la corrispondente data che sono situate nella colonna (B1:B12) del foglio 2 Denominato (Base_Appoggio).
E a sua volta viene visualizzata per l'appunto nella Cella (D14) del Foglio 1 tutto qui .
Non saremo andati oltre ma per lo meno questo lo risolto .
Grazie ancora di tutto cuore peril tuo aiuto e la tua perdita di tempo ; Sinceri Saluti da A.Maurizio

[Anthony47]

Il file allegato e' quello che ho usato per le prove e gli sviluppi.
Le 4 aree gialle corrispondono a 4 metodi di caricamento diversi, descritti in righe 16/17.
La prima, terza e quarta scaricano dal sito oggi.it, tramite le funzioni Oroscopo2 (1°, 3°) e Oroscopo3 (4°); la seconda scarica da donnad.it tramite la funzione OroscopoDD.
Tra Oroscopo2 e Oroscopo3 la differenza e' nel metodo di lettura dei dati: tramite una sessione (non visibile) di I.E. oppure tramite WinHttpRequest. Questo secondo metodo richiede che sia impostato un riferimento nel vba alla libreria Microsoft WinHttpServices e chiede una impostazione di privacy a livello "basso" (altrimenti compaiono avvisi di sicurezza durante la ricezione dei dati).

La prima area e' compilata tramite il pulsante Ricevi Oroscopo; tutte le altre tramite formula inserita nella cella.
A parte gli avvisi di sicurezza che compaiono usando il metodo Oroscopo3, gli altri metodi producono tutti il risultato atteso (cioe' il testo dell'oroscopo), anche se Oroscopo2 e' abbastanza lenta.
Le sessioni I.E. rimangono non visibili e vengono chiuse alla fine; anche controllando con TaskManager non risultano processi iexplore.exe in eccesso.

Il link: https://www.dropbox.com/s/seqrh8fre93c5 ... .xlsm?dl=0

Ciao

[Maury170419]

Un Grazie Immenso Anthony per il tuo Stupendo lavoro
Un Grazie Infinite Anthony per la tua Proverbiale Amicizia e Sopportazione
E un progetto mai visto prima.
Anche sè a dire il vero o tutta solo la Colonna (F) e la Colonna (H) a me funzionano bene , le altre due evidentemente ho qualche problema io con il mio sistema Operativo Windows 10 Pro.
In quanto quando faccio un doppio click per attivare il tutto mi si riavvia sempre la pagina Internet.
Ma tutto ciò non è da Attribuire a te .
Ora ne avro da leggere per almeno un mese prima di capire per filo e per segno cosa realmente hai fatto per risolvere tutto ciò.
Bellissimo Grazie infinite Ancora per tutto Sinceri Saluti da A.Maurizio