Registriert seit: 02.12.2017
Version(en): Office 365
Warum muss es eigentlich eine Userform sein?
Ein Gantt- Diagramm wäre doch auch gut geeignet...
Das lässt sich schnell übertragen und in allen erdenklichen Formen auswerten...
Eine Menge reden, aber nichts sagen können viele...
Registriert seit: 16.03.2018
Version(en): 2007,2016
Daran hab ich gar nicht gedacht.
Ich sehe es mir mal an danke für denn Tipp. :19:
Live is a Game Play it
Registriert seit: 16.03.2018
Version(en): 2007,2016
Also Ich habe mir das ganze nun angesehen.
Ich brauche aber eine UF da Ich Excel ausblende.
Die einfachste Version ist nun die einen Screenshot zu machen aber nur von dem Kalender.
Live is a Game Play it
Registriert seit: 06.12.2015
Version(en): 2016
Hallo,
warum ein Screenshot helfen sollte, konnte ich nicht nachvollziehen.
Wenn du in meinem Code einige If-Abfragen ergänzt, kannst du für jedes Datum den Status auslesen. Mit einer Schleife über alle Appartments und alle Jahre ist eine vollständige Übertragung möglich.
mfg
Registriert seit: 16.03.2018
Version(en): 2007,2016
21.08.2018, 18:06
(Dieser Beitrag wurde zuletzt bearbeitet: 21.08.2018, 18:06 von Florian20.)
Ich habe mir dein Code nochmal angesehen und ja du hast recht.
Aber wie würdest Du das machen?
Gruß flo
Live is a Game Play it
Registriert seit: 06.12.2015
Version(en): 2016
Hallo,
ich hatte mir das noch einmal angesehen:
eine "schöne" Lösung ist (für mich) recht kompliziert
Einfach, aber sehr effizient ist:
Code:
Sub F_en()
Dim HTP As Object
'ungeprüft
Url = "https://apartmani-laemmlein.com/bookingCalendar.php?apartment=1"
With CreateObject("MSXML2.XMLHTTP")
.Open "Get", Url, False
.Send
c00 = .ResponseText
End With
With CreateObject("htmlfile")
.Body.innerhtml = c00
Set Kn = .getElementsByTagName("span")
For Each Zw In Kn
'Debug.Print Zw.innertext, Zw.classname
i=i+1
cells(i,1) = Zw.innertext
Next Zw
End With
End Sub
Jedesmal wenn eine "1" kommt, beginnt ein neuer Monat. Dass Verschieben des Status sollte auch mit 1-2 Zeilen VBA (oder per Hand) gehen.
Die Schleife über die 3 Appartments ebenso. Es wird nur das aktuelle Jahr abgefragt, dafür habe ich i.M. keine Idee.
mfg
Registriert seit: 06.12.2015
Version(en): 2016
versuche es mal so:
Code:
https://apartmani-laemmlein.com/bookingCalendar.php?apartment=1
Sub F_en()
Dim HTP As Object
Url = "https://apartmani-laemmlein.com/bookingCalendar.php?apartment=1"
With CreateObject("MSXML2.XMLHTTP")
.Open "Get", Url, False
.Send
c00 = .ResponseText
End With
With CreateObject("htmlfile")
.Body.innerhtml = c00
Set Kn = .getElementsByTagName("span")
For Each Zw In Kn
'Debug.Print Zw.innertext, Zw.classname
If Zw.innertext <> "" Then
it = Zw.innertext
Else
i = i + 1
Cells(i, 1) = it
Cells(i, 2) = Zw.classname
End If
Next Zw
End With
End Sub
############# Version 2 ############
'Datei als UTF-8 speichern
Sub F_en()
Url = "https://apartmani-laemmlein.com/bookingCalendar.php?apartment=1"
With CreateObject("MSXML2.XMLHTTP")
.Open "Get", Url, False
.Send
c00 = .ResponseText
End With
With CreateObject("htmlfile")
.Body.innerhtml = c00
Set tr = .getElementsByTagName("tr")
i = 1
For Each Ast In tr
Debug.Print Ast.innertext, VBA.MonthName(i)
If VBA.MonthName(i) = Ast.innertext Then
i = i + 1
j = 1
Cells(i, 1) = Ast.innertext
End If
Set Kn = Ast.getElementsByTagName("span")
For Each Zw In Kn
If Zw.Classname <> "day" Then
j = j + 1
Cells(i, j) = Zw.Classname
End If
Next Zw
Next Ast
End With
End Sub
Registriert seit: 16.03.2018
Version(en): 2007,2016
22.08.2018, 08:54
(Dieser Beitrag wurde zuletzt bearbeitet: 22.08.2018, 08:54 von Florian20.)
Hi guten morgen,
Wow krass also Ich hab mir den code angesehen ganz verstehen kann ich Ihn noch nicht, aber bei "Dezember kommt bei mir error.
Laufzeitfehler "5"
Ungültiger Prozeduraufruf oder Ungültiges Argument
Wenn ich ein errorhandler einbaue dann bleibt der "Dezember" leer, ansonsten klapp das extrem gut.
Liebe Grüße Flo
PS: Der code hängt dann bei Ast.innertext in der debug.print anweisung wenn ich diese entferne hängt er in der if abfrage
Live is a Game Play it
Registriert seit: 16.03.2018
Version(en): 2007,2016
Hi Leute,
Ich hab das ganze nochmal durchdacht, und ich würde es gerne so machen wie im webbrowser Element.
Code:
Private Sub CommandButton1_Click()
Dim strText As String, strArray() As String
Dim lngRow As Long, lngCount As Long
strText = WebBrowser1.Document.DocumentElement.outerTEXT
strArray = Split(strText, vbCrLf)
For lngCount = 0 To UBound(strArray)
If Trim$(strArray(lngCount)) <> "" Then
lngRow = lngRow + 1
Cells(lngRow, 1).Value = Trim$(strArray(lngCount))
End If
Next
Unload Me
End Sub
Private Sub UserForm_Activate()
CommandButton1.Enabled = False
WebBrowser1.Navigate "https://apartmani-laemmlein.com/bookingCalendar.php?apartment=1"
End Sub
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
CommandButton1.Enabled = True
End Sub
Problem hier es wird nach unten angezeigt und die Buttons unterhalb des Kalenders werden angezeigt.
Zudem kann ich nicht nach Monaten schalten.
Frage:
Wäre es möglich mit dem Element das so zu machen wie Ich das brauche?
lg flo
Live is a Game Play it