Oroscopo Aggiornato con Excel

[A.Maurizio]

Buon Giorno a tutti , mi chiamo Maurizio ; sono un Appassionato di programmazione da Sempre , pur essendo un Autodidatta .
In mio problema e questo : in Excel dopo essermi Costruito con l'ausilio di un UserForm un Calendario Cosidetto Perpetuo , e fino a qui nulla di Eclatante ; pero' a vederlo bene , Capisco che sarebbe più bello se Riuscissi a Far visualizzare all'interno di una Label o di una Listbox una lettura Aggiornata di un Oroscopo recuperando il Tutto da una Data Immessa ; mi spiego Meglio : Nel mio Calendario c'è la possibilità non solo di Inserire una Data per visualizzarne il Proprio Calendario , sia Esso Mensile che Annuale , ma Visualizzarne anche il proprio Segno Zoodiacale .
Ora come dicevo prima vorrei trovare il modo Di fare si ! un Collegamento diretto ad Internet , ma senza però aprire nessuna pagina ; ma Semplicemente Riuscire a Ricavarne il Suo Oroscopo e Ritrascriverlo in una label .
Tutto cio' e possibile ? se si come si fa.
Sin da ora vi porgo i miei saluti e un grazie a tutti coloro che vorranno darmi una mano per realizzare tutto cio' ; A.Maurizio

[Anthony47]

Ciao Maurizio, benvenuto nel forum.
Immagino che il tuo calendario sia costruito con l' oggetto Calendar Control.
Quanto all' oroscopo (trattenendomi dal fare commenti sulla convivenza tra excel=numeri=calcoli e oroscopo=fuffa), se pubblichi un sito da cui si possa estrarre un oroscopo perpetuo vedremo cosa si puo' fare.

Ciao

[A.Maurizio]

Ciao AntHony47 mi Chiamo Maurizio , spero d'aver fatto la cosa Giusta , nel Voler Rispondere alla tua Domanda sul mio problema sull'oroscopo Aggiornato , Sfruttando questa parte del Forum ; ma essendo nuovo iscritto non vorrei essermi Sbagliato ; Sé cosi fosse chiedo scusa .
Comunque sia No ! non o Usato nessun Oggetto Calendario ; ma ben si il mio viene svolto tutto da Codice ; in fatti ti dirò , che per Essere un Autodidatta mi e venuto abbastanza bene .
Però come dicevo nella mia Richiesta mi Piacerebbe poterlo rendere ancora più Interessante se riuscissi a sviluppare anche una Sorta di Locandina dove venga Riportato L'oroscopo letto Direttamente da Internet ; Senza però doverlo Aprire a priori Per leggere il Tutto .
Spero di Essermi Spiegato a Dovere ; Grazie ancora del Tuo Interessamento , Sinceri saluti da Maurizio

[Anthony47]

So per esperienza che per un autodidatta ogni realizzazione che funziona come si voleva e' una soddisfazione...
Quanto alla prestazione aggiuntiva la mia richiesta e' di sapere da quale sito web si puo' prelevare un oroscopo personalizzato, non avendo io nessuna esperienza in fatto di oroscopi.

Ciao

[A.Maurizio]

Ciao Anthony47 grazie del Tuo Interessamento , ma non saprei Rispondere a Questa tua domanda , con concretezza ; però l'unica cosa che posso suggerirti se e questo cio' che ti serve per potermi dare una Mano , e quella di andare a vedere sul Sito : www.PaoloFox.it .
Oppure sé per caso avessi il Sistema operativo Windows 8 , nel Menu Start c'e' una App Rappresentante L'oroscopo del giorno ; che poi alla Fin Fine nel Suo insieme , e poi cio' che vorrei Ottenere Io con Excel .
Tutto qui , Sinceri saluti da A.Maurizio

[Flash30005]

Nel sito da te indicato non c'è alcun oroscopo del giorno ma solo le caratteristiche di ogni segno zodiacale e non credo sia questo quello che vorresti riportato in Excel

fai sapere
Ciao

[A.Maurizio]

Ciao Anthony Vediamo sé riesco cosi a Farti capire Bene ciò che intendo dire : Ipotizziamo che tu Volessi Visualizzare il tuo oroscopo Giornaliero , su Internet : 1 ) Apri la pagina Oroscopi - 2 ) Vai al Tuo Segno Zodiacale - 3 ) leggi la Tua Locandina e Tutto Finisce li .
Ora la mia Domanda e poi Sempre la Stessa : è possibile Estrarre da Internet Solo ed Esclusivamente tale Locandina o farla Copiare in modo che si riporti il Tutto all'interno di una Label ho di una textBox o quant'altro .
Penso che non sia poi cosi difficile da capire tutto cio'.
A te lascio libera Interpretazione di questo mio desiderio ; sinceri saluti da A. Maurizio

[scossa]

... Ipotizziamo che tu Volessi Visualizzare il tuo oroscopo Giornaliero , su Internet : 1 ) Apri la pagina Oroscopi - 2 ) Vai al Tuo Segno Zodiacale - 3 ) leggi la Tua Locandina e Tutto Finisce li .

Di quale pagina oroscopi stai parlando? Non esiste "La pagina Oroscopi": il browser vuole una URL precisa che porti ad una pagina contenente l'oroscopo: se non ci indichi l'URL di quella pagina ....
In pratica qualcuno dovrebbe spulciare tutte le pagine di oroscopi che ci sono on-line per trovarne una che ti soddisfi, ma questa ricerca dovresti farla tu, non trovi?

[Anthony47]

Ciao Anthony Vediamo sé riesco cosi a Farti capire Bene ciò che intendo dire : Ipotizziamo che tu Volessi Visualizzare il tuo oroscopo Giornaliero , su Internet : 1 ) Apri la pagina Oroscopi - 2 ) Vai al Tuo Segno Zodiacale - 3 ) leggi la Tua Locandina e Tutto Finisce li .
Ora la mia Domanda e poi Sempre la Stessa : è possibile Estrarre da Internet Solo ed Esclusivamente tale Locandina o farla Copiare in modo che si riporti il Tutto all'interno di una Label ho di una textBox o quant'altro .
Penso che non sia poi cosi difficile da capire tutto cio'.

Fin dal primo mio post ho cercato di spiegare che con gli oroscopi non sono familiare (ne' penso di approfondire in futuro); quindi io non apro nessuna pagina Oroscopo, non gli dico il mio segno zodiacale, non leggo la mia locandina.
Ma ho sempre detto che se mi dici DOVE un oroscopo personalizzato puo' essere prelevato (da quale pagina web, cioe' da quale "url") avrei provato a importarlo in excel; sono fermo a quello stadio di subordinata disponibilita'.

Ciao

[A.Maurizio]

Ciao Anthony Grazie infinite della Tua Proverbiale pazienza , ora che o capito quale e il Tuo Problema ti Invio questi due Indirizzi Internet che sono poi cio' che stai cercando Tu ; che sono : "
Questo e L'indirizzo Per Accedere ai Singoli Simboli " http://oroscopo.donnad.it/oroscopo/settimanale

" Questo è L'indirizzo per Visualizzare L'Oroscopo Desiderato , ad Esempio " http://oroscopo.donnad.it/oroscopo/sett ... /segno/s/1

Questo e il Primo Segno Zodiacale, Cioè : Ariete
Oroscopo che desidero Copiare nella TextBox o una Label ho una ListBox :
-------------------------------------------------------------------------------------------------------------------------
Ariete
21 marzo - 20 aprile
Venere insieme a Marte, Nettuno e Giove, tutti positivi, possono donarvi grinta ed energia attiva nei confronti dell'ambiente professionale, apportandovi ottimi incarichi professionali.

Grazie ancora di Tutto Sinceri Saluti da A. Maurizio

[Flash30005]

Con questa macro riporti in un foglio di Excel (su tre righe)
ciò che ti interessa

Codice: Seleziona tutto

Sub Macro3()
    Cells.Delete Shift:=xlUp
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://oroscopo.donnad.it/oroscopo/settimanale/segno/s/1", Destination:= _
        Range("A1"))
        .Name = "1_1"
        .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
    Rows("163:333").Delete Shift:=xlUp
    Rows("1:157").Delete Shift:=xlUp
    Rows("4").Delete Shift:=xlUp
    Rows("2").Delete Shift:=xlUp
End Sub


Rendendo "variabile" l'indirizzo della queryweb nella macro potrai ottenere altri dati

Ciao

[Anthony47]

Guarda il suggerimento di Flash, sopra.
Da parte mia ho sviluppato una "funzione" che dovrebbe restituirti il testo dell' oroscopo in una variabile, che potrai poi usare per scrivere il testo di una label nella tua form.
Il codice

Codice: Seleziona tutto

Function Oroscopo(ByVal Segno As Long) As String
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=99714
'
Dim HttpReq As WinHttpRequest, PageSrc As String, Doc As New HTMLDocument
Dim myColl, myTag, myBase As String
'
myBase = "http://oroscopo.donnad.it/oroscopo/settimanale/segno/s/"
'
If HttpReq Is Nothing Then Set HttpReq = New WinHttpRequest
'
HttpReq.Open "GET", myBase & Segno
HttpReq.Send
PageSrc = HttpReq.ResponseText
'
Set Doc = New HTMLDocument
Doc.Clear
CallByName Doc, "Write", VbMethod, PageSrc
'
Set myColl = Doc.getElementsByTagName("div")
For Each myTag In myColl
    If myTag.className = "description" Then
        Oroscopo = myTag.innerText
'        MsgBox (myTag.innerText)
        Exit For
    End If
Next myTag
End Function


E' TUTTAVIA NECESSARIO impostare due "riferimenti" aggiuntivi, nel vba: alla Microsoft HTML Object Library e alla Microsoft WinHTTP services (io ho la versione 5.1, ma anche la 5 dovrebbe andare bene).
Quindi, mentre sei nell' editor delle macro:
-Menu /Strumenti /Riferimenti
-scorri l' elenco delle librerie disponibili, aggiungi la spunta alle due voci che ti ho detto, conferma con Ok (non toccare le altre spunte...)

Poi nel tuo codice userai qualcosa come

Codice: Seleziona tutto

Label1.Caption = Oroscopo(segno)


Io per prova ho usato questa macro, che mi rende il testo in un messagebox:

Codice: Seleziona tutto

Sub OTest()
Dim mySegno As Long
mySegno = 1    '<<< Variare
MsgBox (Oroscopo(mySegno))
End Sub


Variando il numero otterrai oroscopi dei segni corrispondenti.

In questo modo visualizzerai sempre l' oroscopo della data corrente, mentre inizialmente avevo inteso che avresti voluto visualizzare l' oroscopo per la data visualizzata dal calendario perpetuo... Anche questo probabilmente sarebbe fattibile, se ci fosse un sito che ti calcola l' oroscopo per data, oltre che per segno.

Ciao

[scossa]

Oltre alle soluzioni proposte da Flash e da Anthony (ciao), propongo una ulteriore alternativa.
Si tratta di una udf che quindi può essere utilizzata sia lato VBA che in una cella e non richiede riferimenti a librerie aggiuntive.
Permette di passarele, come argomento, il segno voluto sia come numero (p.e.: 3) che come testo (p.e.: "acquario").

L'udf estrae dalla pagina relativa al segno il solo paragrafo, ripulito di caratteri inutili, relativo all'oroscopo.

Ovviamente, operando su di una pagina web, funziona finché viene mantenuta la struttura attuale (presenza del tag <h2> per identificare il paragrafo desiderato).

Esempi di utilizzo in VBA:

Codice: Seleziona tutto

Sub prova()
  MsgBox Oroscopo("acquario")
  MsgBox Oroscopo(8)
End Sub


Esempi di utilizzo in una cella:
=Oroscopo("acquario")

Questo il codice della function:

Codice: Seleziona tutto

'---------------------------------------------------------------------------------------
' Procedure : Oroscopo
' Author    : scossa
' Date      : 20/08/2013
' Argomenti : vSegno numero da 1 (Ariete) a 12 (Pesci), oppure stringa (p.e: "ariete")
' Purpose   : legge il contenuto della pagina web
'             e restituisce il solo testo dell'oroscopo del segno vSegno
'---------------------------------------------------------------------------------------
'
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

  Application.ScreenUpdating = False
 
  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 = UCase(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 = Mid(sSource, nAtP, nAtCP)
  sOroscopo = sSegno & vbCrLf & 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


[scossa]

Questo il codice della function:

Codice: Seleziona tutto

'..... CUT

  Application.ScreenUpdating = False

 .....

Ovviamente un refuso di una prima versione come sub.

Altra modifica consigliata:
sostituire

Codice: Seleziona tutto

sOroscopo = sSegno & vbCrLf & Trim(Replace(Replace(Replace(sOroscopo, vbLf, ""), vbCr, ""), vbTab, ""))

che richiede di impostare il "testo a capo" nella cella, con

Codice: Seleziona tutto

sOroscopo = Trim(Replace(Replace(Replace(sOroscopo, vbLf, ""), vbCr, ""), vbTab, ""))

[A.Maurizio]

Ciao a Tutti a Partire da Scossa - Anthony47 - Flash - Flash30005 ecc...! Non so' proprio come potervi Ringraziare per essere riusciti a Darmi tutti questi Suggerimenti su' questo mio problema , in quanto senza di Voi Sicuramente non sarei mai Riuscito a Farcela da Solo .
E per rispondere ad " Anthony " riferendosi al Fatto che pensavi Io Volessi Sfruttare questa Tecnica All'interno del Mio Calendario Perpetuo ! : in effetti e proprio Cosi ora Cerchero' di Fare in modo , che tutto ciò ; possa Comparire nel momento in qui venga estratta dalla mia Cartella dei SegniZodiacali che nel mio Programma e gia Funzionante , anche il Suddetto Oroscopo .
Il Tutto Grazie al Vostro Aiuto .
Ecco perchè , mi Permetto di chiedervi sempre che il tutto possa farvi Piacere : di Inviarmi una vostra E_mail al mio indirizzo che è : "*******@gmail.com " ; in modo che una volta terminato il mio Lavoro ; ve ne possa Inviare anche a tutti voi una Copia .
Tutto questo in forma Puramente di Amicizia , in caso controrio pazzienza ! Comunque sia Grazie ancora di tutto , Sinceri Saluti a tutti da A. Maurizio

[Anthony47]

Lieto che hai trovato lo spunto giusto nel nostro forum...

Ho mascherato l' indirizzo di email, che non e' mai prudente pubblicare in chiaro su un forum; chi vuole aderire alla richiesta di a.maurizio puo' farlo comunicando tramite messaggio privato.
Da parte mia, non volermene ma declino l' invito: ho molti piu' file excel di quanti ne potrei mai gestire.

Ciao a tutti.

[Flash30005]

Nemmeno a farlo apposta se non ci si logga in Pc-Facile, ogni tanto, appare questo



Uploaded with ImageShack.us