Live tabellen van internet invoegen

[Geyzes]

Voor mijn sportclub maak ik een 2wekelijkse powerpoint.

Tot nu toe moest ik steeds de klassementen handmatig kopieren en plakken week om week.
Zou dit automatisch kunnen?


Blijkbaar kan het niet via de liveweb plugin van ppt maar het zou mogelijk moeten zijn via een plugin van Excel
-> "gegevens" ribbon -> "externe gegevens ophalen" knop -> "van web" -> website URL ingeven

dit gaat, maar enkel voor de standaard tabel selectie.
Op de website waar ik de klassementen moet afhalen kan je telkens de reeks selecteren.
Maar een andere reeks dan de standaardreeks krijg ik niet geselecteerd.
Zie hier:
http://volley-avf.be/competitie/klassementavf.php


Er is ook een RSS klassement aangeboden als iemand me daarmee verder kan helpen is het ook goed.
http://volley-avf.be/competitie/rangschikking_rss.htm

het zou me enorm veel werk besparen, alvast bedankt!

 

[Brent2002]

Met Excel kan het best goed gaan. Dan kun je de namen kopiëren, en de score als die gelijk is gebleven ook.

Met vriendelijke groet,

Brent

 

[Geyzes]

kopieren is niet echt de bedoeling, het zou automatisch moeten gaan.
Anders heb ik nog niets gewonnen. Alsnog bedankt

 

[Brent2002]

Sorry, dan heb ik uw vraag verkeerd geïnterpreteerd. Dan snapte ik niet wat u bedoelde. Want wat bedoelt u dan met automatisch (kopiëren)?

Met vriendelijke groet,
Brent

 

[Geyzes]

Elke week worden er wedstrijden gespeeld en deze worden automatisch op het internet verwerkt.
Gevolg:
Elke week is er een nieuw klassement.


Wat ik nu doe is voor elk van de 20 ploegen het klassement kopieren/plakken/opmaken.
Bedoeling is dit automatiseren.

1e idee: via liveweb in PPT de livewebsite weergeven maar dit is niet wenselijk gezien dan de volledige website wordt weergegeven
2e idee (waar ik nu dus hulp om vraag): Via Excel de tabellen invoegen van de website (eventueel via een macro een wekelijkse update) en een link van PPT naar Excel...

Zo moet ik in plaats van wekelijks 20 klassementen bij te werken, slechts Excel te openen, Macro starten en hetzelfde evt. met PPT.


Hopelijk kan je me nu beter helpen, alvast bedankt voor de moeite!

 

[Brent2002]

Dus als ik u goed begrijp, wilt u dat het kopiëren en plakken automatisch gaat. Ik denk dat ik u dan helaas niet meer kan helpen (als mijn redenatie klopt).

Groetjes,
Brent

 

[Geyzes]

Inderdaad ik wil een "live" update bij het openen moet daarom niet realtime zijn.

Alsnog bedankt!

 

[alphamax]

zoiets, ik ben niet zo goed bekend met powerpoint VBA

[SIZE=1]Option Explicit

Public Sub Main()
    Dim strResponseText As String
    Dim objTable As Object
    Dim lngRow As Long
    Dim lngColumn As Long
        Worksheets("Blad1").Cells(2, 1).CurrentRegion.ClearContents
        With CreateObject("MSXML2.XMLHTTP")
            .Open "POST", "http://volley-avf.be/competitie/klassementavf.php", False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send ("Reeks=H+2+P+A&Wat=2")
            Do
                DoEvents
            Loop While .readystate <> 4
            Application.Wait (Now + TimeValue("00:00:01"))
            strResponseText = .responsetext
            With CreateObject("HTMLFILE")
                .write strResponseText
                For Each objTable In .getelementsbytagname("table")
                    With objTable
                        If .Cells(1, 1).innertext = "Nr" Then
                            For lngRow = 0 To .Rows.Length - 1
                                For lngColumn = 1 To .Rows(1).Cells.Length - 1
                                    Worksheets("Blad1").Cells(2, 1).Offset(lngRow, lngColumn).Value = .Rows(lngRow).Cells(lngColumn).innertext    'am_2013
                                Next
                            Next
                            With Worksheets("Blad1").Cells(2, 1).CurrentRegion
                                .Cells.WrapText = False
                                .Columns.AutoFit
                            End With
                        End If
                    End With
                Next
            End With
        End With
End Sub[/SIZE]

druk op (linker)ALT+F11 voor de code

 

[pixcel]

Weer knap gedaan Alpha! :thumb:

Ik vermoed dat ts liever 20 bladen heeft met standen dan een keuzemenu. De excel bereiken moeten immers nog gekoppeld worden aan zijn ppt. Het zou wel handig zijn om een voorbeeld hiervan te zien.

Bijgevoegd de alternatieve aanpak, met de xml-feed. Jammergenoeg is die slecht gestructureerd waardoor er nog relatief veel code nodig is om de boel te splitsen. En dat gaat ook duidelijk nog niet helemaal goed. Maar het gaat om het idee. Toch?
Vernieuw de feed door even van werkblad te wisselen.

 

[alphamax]

voor de liefhebbers
HTML-tabel gekopieerd naar het klembord (zonder MSForms.DataObject referentie maar met de late binding GUID hiernaar)

Option Explicit

Public Sub Main()
    Dim strResponseText As String
    Dim objTable As Object
    Worksheets("Blad1").Cells(2, 1).CurrentRegion.Clear
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://volley-avf.be/competitie/klassementavf.php", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send ("Reeks=" & Worksheets("Blad1").Range("M6").Value & "&Wat=2")
        Do
            DoEvents
        Loop While .readystate <> 4
        Application.Wait (Now + TimeValue("00:00:01"))
        strResponseText = .responsetext
        With CreateObject("HTMLFILE")
            .write strResponseText
            For Each objTable In .getelementsbytagname("table")
                With objTable
                    If .Cells(1, 1).innertext = "Nr" Then
                        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")    'http://desmondoshiwambo.wordpress.com/2012/02/23/how-to-copy-and-paste-text-tofrom-clipboard-using-vba-microsoft-access/
                            .SetText objTable.outerhtml
                            .PutInClipboard
                        End With
                        Paste Worksheets("Blad1").Cells(2, 1)
                        With Worksheets("Blad1").Cells(2, 1).CurrentRegion
                            .Cells.WrapText = False
                            .Columns.AutoFit
                            .Select
                        End With
                    End If
                End With
            Next
        End With
    End With
End Sub

 

[Geyzes]

Weer knap gedaan Alpha! :thumb:

Ik vermoed dat ts liever 20 bladen heeft met standen dan een keuzemenu. De excel bereiken moeten immers nog gekoppeld worden aan zijn ppt. Het zou wel handig zijn om een voorbeeld hiervan te zien.

Bijgevoegd de alternatieve aanpak, met de xml-feed. Jammergenoeg is die slecht gestructureerd waardoor er nog relatief veel code nodig is om de boel te splitsen. En dat gaat ook duidelijk nog niet helemaal goed. Maar het gaat om het idee. Toch?
Vernieuw de feed door even van werkblad te wisselen.

Wat je zegt klopt inderdaad, het resultaat is wat ik wenste maar met de codes etc. kan ik allemaal al niet meer volgen.
Ik bekijk het deze week even op het gemakje...


alvast bedankt!!

 

[pixcel]

Als ik jou was zou ik me niet blindstaren op die code maar eens met de beheerder van die site gaan praten. Leg uit wat je wilt en vraag of ze kunnen helpen. Vraag evt of ze de CData sectie in de rss feed in gewoon xml kunnen aanbieden. Dan kun je alles via de userinterface van Excel regelen, geen vba meer nodig.