|
| HOMEPAGE | INDICE FORUM | REGOLAMENTO | ::. | NEI PREFERITI | .:: | RSS Forum | RSS News | NEWS web | NEWS software | |
| PUBBLICITA' | | | ARTICOLI | WIN XP | VISTA | WIN 7 | REGISTRI | SOFTWARE | MANUALI | RECENSIONI | LINUX | HUMOR | HARDWARE | DOWNLOAD | | | CERCA nel FORUM » | |
09-05-2017, 18.11.30 | #1 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Associate the Zodiac with Your Monthly Horoscope in VBA
And my question and this: Time ago I was able to create a program entirely in VBA Using an Excel sheet, where I was looking for the zodiac sign I wanted through a ComboBox, and then pressing a button I called my Horoscope. Everything using this Code: ################################### Codice:
Private Sub Cmd_AvviaOroscopo_Click() On Error Resume Next Range("F2").Value = "" & ListBox1.Text 'vSegno = Target vSegno = Range("J2").Value & "" Range("F2").Value = "" & Oroscopo(vSegno) End Sub Codice:
Public Function Oroscopo(ByVal vSegno As Variant) As String Dim sSource As String Dim aSegni As Variant Dim j As Integer Dim sSegno As String Dim nSegno As Integer Dim sOroscopo As String Dim Http1 As Object Dim sUrl As String Dim nAtH2 As Long Dim nAtP As Long Dim nAtCP As Long On Error GoTo Oroscopo_Error aSegni = Split("Ariete Toro Gemelli Cancro Leone Vergine Bilancia Scorpione Sagittario Capricorno Acquario Pesci") If IsNumeric(vSegno) Then nSegno = vSegno sSegno = aSegni(nSegno - 1) Else sSegno = vSegno For j = 0 To 11 If aSegni(j) = sSegno Then nSegno = j + 1 End If Next End If Set Http1 = CreateObject("MSXML2.XMLHTTP") sUrl = "http://oroscopo.donnad.it/oroscopo/settimanale/segno/s/" & nSegno Http1.Open "GET", sUrl, False Http1.Send sSource = Http1.ResponseText Set Http1 = Nothing nAtH2 = InStr(1, sSource, "</h2>", vbTextCompare) nAtP = InStr(nAtH2, sSource, "<p>", vbTextCompare) + 3 nAtCP = InStr(nAtP, sSource, "</p>", vbTextCompare) - nAtP sOroscopo = VBA.Mid(sSource, nAtP, nAtCP) sOroscopo = sSegno & vbCrLf & VBA.Trim(Replace(Replace(Replace(sOroscopo, vbLf, ""), vbCr, ""), vbTab, "")) Oroscopo_Error: If Err.Number <> 0 Then Set Http1 = Nothing sOroscopo = "Non disponibile!" End If Oroscopo = sOroscopo End Function Here is my question and this: There would not be another way to view it all without adopting my Criterion. Thank you for all the help you want to give me, Sincerely greetings from A.Maurizio |
09-05-2017, 21.09.15 | #2 |
Gold Member
Registrato: 20-05-2004
Loc.: Perugia
Messaggi: 4.188
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Se ti chiami Maurizio perché non scrivi in italiano?
___________________________________
Ogni computer ha la sua storia. Dermatite Seborroica? www.dermatiteseborroica.info |
10-05-2017, 18.47.18 | #3 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Ciao RunDLL hai Pienamente ragione a dire che mi chiamo (Maurizio) anche sé a dire il Vero sono di Origine (Spagnola)
Ma ho scritto in Inglese in quanto Google mi dava inizialmente una traduzione del vostro Forum come lingua (Inglese) e poi subito dopo e passato All'italiano, per qui non sapendo bene come coportarmi , ho pensato bene di scrivere in Inglese; Tutto qui. Ora e in Italiano Grazie infinite per la tua Puntualizzazione. ############################################### E la mia Domanda e questa : Tempo fa ero riuscito a creare un programma totalmente in VBA Sfruttando un Foglio di Excel, dove cercavo il Segno zodiacale da me desiderato attraverso una ComboBox, e poi premendo un Tasto Richiamavo il proprio Oroscopo. Il Tutto utilizzando questo Codice: Codice:
Private Sub Cmd_AvviaOroscopo_Click() On Error Resume Next Range("F2").Value = "" & ListBox1.Text 'vSegno = Target vSegno = Range("J2").Value & "" Range("F2").Value = "" & Oroscopo(vSegno) End Sub Codice:
Public Function Oroscopo(ByVal vSegno As Variant) As String Dim sSource As String Dim aSegni As Variant Dim j As Integer Dim sSegno As String Dim nSegno As Integer Dim sOroscopo As String Dim Http1 As Object Dim sUrl As String Dim nAtH2 As Long Dim nAtP As Long Dim nAtCP As Long On Error GoTo Oroscopo_Error aSegni = Split("Ariete Toro Gemelli Cancro Leone Vergine Bilancia Scorpione Sagittario Capricorno Acquario Pesci") If IsNumeric(vSegno) Then nSegno = vSegno sSegno = aSegni(nSegno - 1) Else sSegno = vSegno For j = 0 To 11 If aSegni(j) = sSegno Then nSegno = j + 1 End If Next End If Set Http1 = CreateObject("MSXML2.XMLHTTP") sUrl = "http://oroscopo.donnad.it/oroscopo/settimanale/segno/s/" & nSegno Http1.Open "GET", sUrl, False Http1.Send sSource = Http1.ResponseText Set Http1 = Nothing nAtH2 = InStr(1, sSource, "</h2>", vbTextCompare) nAtP = InStr(nAtH2, sSource, "<p>", vbTextCompare) + 3 nAtCP = InStr(nAtP, sSource, "</p>", vbTextCompare) - nAtP sOroscopo = VBA.Mid(sSource, nAtP, nAtCP) sOroscopo = sSegno & vbCrLf & VBA.Trim(Replace(Replace(Replace(sOroscopo, vbLf, ""), vbCr, ""), vbTab, "")) Oroscopo_Error: If Err.Number <> 0 Then Set Http1 = Nothing sOroscopo = "Non disponibile!" End If Oroscopo = sOroscopo End Function Per qui la mia domanda e questa: Non ci sarebbe un altro modo sempre per visualizzare il tutto senza adottare il mio Criterio. Grazie sin da ora per tutto l'aiuto che vorrete darmi in merito, Sinceri saluti da A.Maurizio |
10-05-2017, 19.58.35 | #4 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Ciao RunDLL Preferisco che provi questo Progetto in quanto rispecchia meglio il mio Desiderio sul mio oroscopo del Mese.
Premetto che non funziona comunque , però forse per te e più facile da capire ae dove poter mettere le mani ; Grazie |
10-05-2017, 23.37.47 | #5 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
ci sono un paio di problemi.
1) nel codice della form relativo al tasto "OK" hai messo il codice Codice:
Private Sub Cmd_Scrivi_Oroscopo_Click() Dim mySegno As Long mySegno = Me.TextBox1.Text '<<< Variare MsgBox (Oroscopo1(mySegno)) End Sub Codice:
Private Sub ComboBox1_Change() Me.TextBox1.Text = Me.ComboBox1.Text End Sub in sostanza il codice del combo diventa Codice:
Private Sub ComboBox1_Change() y = ComboBox1.ListIndex + 1 End Sub Il 2° problema è che ...... la pagina che cerchi nella funzione Oroscopo1 .... non esiste più in quel sito è diventata una cosa del genere h***p://www.donnad.it/in-intimita/oroscopo-e-sogni/oroscopo-settimanale/ariete-21-marzo-20-aprile-44 e non come è inserito nella funzione h***p://oroscopo.donnad.it/oroscopo/settimanale/segno/s/ a cui aggiungi solo il valore del segno in scelto in forma numerica
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
11-05-2017, 12.44.07 | #6 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Ciao Alexsandra ascolta : non sò se ho eseguito alla lettara le tue indicazioni , però ho cercato di tradurre il tutto in questo modo :
Codice:
Private Sub Cmd_Scrivi_Oroscopo_Click() Dim mySegno As Long Dim Y As Variant mySegno = Me.TextBox1.Text '<<< Variare MsgBox (Oroscopo1(Segno, Y & mySegno)) End Sub Private Sub ComboBox1_Change() Y = ComboBox1.ListIndex + 1 Me.TextBox1.Text = Y End Sub Codice:
Public Function Oroscopo1(ByVal Segno As Long, ByVal Y As Long) As String Però vorrei anche dire che nel mio piccolo anche come ti avevo documentato io nel primo post funzionava benissimo qualche anno fa. Poi chiaramente come dici tu la pagina in questione e scaduta per qui attualmente non la riconosce più; per qui risulta vuota. Ahora la mia successiva domanda e questa : Apportate tutte quese modifiche che tu mi hai suggerito . In più ho anche cambiato indirizzo Html da : Codice:
h***p://oroscopo.donnad.it/oroscopo/settimanale/segno/s/ Codice:
http://www.oggi.it/oroscopo/oroscopo-della-settimana/ Grazie Sincero da A.Maurizio |
12-05-2017, 15.45.46 | #7 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
No, non va messa così la variabile, non va bene.
Dal codice iniziale che hai postato mi sembra che tu vuoi importare l'oroscopo selezionato e portarlo a video in un box Per fare questo l'oroscopo deve essere inserito in una tabella (nella pagina web), trovarne il nome o l'indice(della tabella) e rifare la query. Se non si estrapola il nome/indice della tabella importi tutta la pagina, per cui il 1° passo è di scegliere il sito più adatto e trovare il nome della tabella, il resto è facile
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
12-05-2017, 18.14.58 | #8 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Ciao Alexsandra per cortesia non potresti farmi un Esempio Pratico
anche solo per il primo segno zodiacale , poi una volta capito il tutto me la cavo da solo . Ma come mi hai spiegato tu non ho capito assolutamente nulla. Grazie ancora una volta della tua pazienza Saluti da A.Maurizio |
12-05-2017, 18.58.11 | #9 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Ciao Alexandra Prova a Guardare questo File e più o meno Simile all'altro solo leggermente Migliorato.
Ma comunque non funziona Più neppure questo. Grazie da A.Maurizio |
13-05-2017, 01.16.36 | #10 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
allora .....
c'è un problema, se interroghi una pagina web con una query carichi delle tabelle, ma moltissimi siti usano degli script per mostrare a video il testo, che risiede in un DB. E' meglio usare l'html e guardando il codice sorgente della pagina che riporta l'oroscopo ogni cosa è inclusa in un oggetto che ha anche un nome. Nel ns. caso quello che ci serve ha il nome di article-oroscopo. cancella (o sposta) tutto il codice che hai nel foglio1 e inserisci questo Codice:
Private Sub Cmd_AvviaOroscopo_Click() Dim y, URL As String Dim htm As Object y = Range("J2").Value URL = "http://www.oroscopi.info/oroscopo-giorno-" & y & ".html" Set htm = CreateObject("htmlFile") With CreateObject("msxml2.xmlhttp") .Open "GET", URL, False .send htm.body.innerHTML = .responseText End With With htm.getElementById("article-oroscopo") ThisWorkbook.Worksheets("Foglio1").Range("F2").Value = .innerText End With htm.Close Set htm = Nothing End Sub NB: devi inserire i segni zodiacali in minuscolo nel range C1:C12 così come sono ti danno un errore. ti allego anche il file modificato
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
13-05-2017, 10.57.11 | #11 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Grazie Infinite Alexsandra Oltre a dirti che sei Fantastico in quanto il tuo progetto e Davvero Superlativo.
Devo dirti anche Grazie di Tutto cuore perché senza di te non sarei riuscito a fare nulla. Perché se e vero che tale progetto lo creato da me , e anche vero che per certi versi mi ero fatto aiutare dai visitatori del Forum PC-Facile che anche a loro devo togliere tanto di cappello. ma ora a distanza di tempo non sapevo più dove mettere le mani. Ecco il perché ancora una volta ti devo dire Grazie e Buon Fine Settimana da A.Maurizio |
14-05-2017, 18.39.26 | #12 |
Newbie
Registrato: 23-12-2015
Messaggi: 43
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Ciao Alexsandra sempre che non sia per te un problema di perdita di tempo.
Vorrei chiederti ancora un piccolo Aiutino che è questo : Nella formazione del tuo oroscopo : che ripeto và benissimo, ho notato che c'é molta distanza trà la Data; Il Seme scelto; e la descrizione del proprio oroscopo. Per qui la mia domanda e questa: Non c'è la possibilità di ridurre il tutto , cosi chè io possa anche inserire qualche grado in più come formato testo senza stravolgere tutto il tuo lavoro. Grazie Saluti da A.Maurizio |
15-05-2017, 13.49.13 | #13 |
Gold Member
Registrato: 20-05-2004
Loc.: Perugia
Messaggi: 4.188
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
ehm, fantasticA
___________________________________
Ogni computer ha la sua storia. Dermatite Seborroica? www.dermatiteseborroica.info |
15-05-2017, 14.54.48 | #14 | |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
Quegli spazi dipendono dal sito web da cui si scarica l'oroscopo, si può tagliare del testo una volta inserito nella cella. provo a vedere se c'è un altro sito con un codice più pulito, altrimenti ci si deve "arrangiare" ed aggirare il problema elaborando la stringa nella cella
Quota:
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
|
15-05-2017, 16.26.09 | #15 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
Rif: Associate the Zodiac with Your Monthly Horoscope in VBA
prova questo se ti va bene.
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
Utenti attualmente attivi che stanno leggendo questa discussione: 1 (0 utenti e 1 ospiti) | |
Strumenti discussione | |
|
|
Discussioni simili | ||||
Discussione | Autore discussione | Forum | Risposte | Ultimo messaggio |
Thread delle freddure | NightMan | Chiacchiere in libertà | 111 | 06-03-2008 16.35.05 |