I have a problem for which I can not find the solution on my own. I tried to read out the values from the following website: https://datawrapper.dwcdn.net/6E03v/580/. I think I have managed to find the corresponding part in the code of the website which is
THIS ONE. As per my understanding the values can be found with tag "span" or class "fg", but none of them seems to work. This is the code I am using for it in the version I use tag "span":
Dim WertFG As Selenium.WebElement
Dim WerteFG As Selenium.WebElements
Dim strTargetTab As String
Dim lgNaechsteFreieZeileZwiSpTblFaelleNachAlter As Long
Dim lgSpalte As Long
Dim lgNaechsteFreieZeileReiterNTVCoronadaten As Long
'Wertzuweisung Variablen
Set ChromeBrowser = New Selenium.ChromeDriver
'Chrome starten und auf die relevante Seite für die gesuchte TabelleCoronaVirusPandemieParameter gehen
ChromeBrowser.Start baseUrl:="https://datawrapper.dwcdn.net/"
ChromeBrowser.Get "/6E03v/577/"
'Werte auslesen
strTargetTab = ThisWorkbook.Worksheets("ZwiSp Tbl Fälle nach Alter").Name
ThisWorkbook.Worksheets(strTargetTab).Activate
ThisWorkbook.Worksheets(strTargetTab).Range("A1:A50").ClearContents
Application.Wait (Now + TimeValue("00:00:03"))
'Tabellenwerte auslesen
Set WerteFG = ChromeBrowser.FindElementsByTag("span")
lgNaechsteFreieZeileZwiSpTblFaelleNachAlter = ThisWorkbook.Worksheets(strTargetTab).Cells(Rows.Count, 1).End(xlUp).Row + 1
lgSpalte = 1
For Each WertFG In WerteFG
ThisWorkbook.Worksheets(strTargetTab).Cells(lgNaechsteFreieZeileZwiSpTblFaelleNachAlter, lgSpalte).Value = WertFG.Text
lgNaechsteFreieZeileZwiSpTblFaelleNachAlter = lgNaechsteFreieZeileZwiSpTblFaelleNachAlter + 1
Next WertFG
ChromeBrowser.Close
Does someone have an idea, why this does not work? Has it something to do with the fact, that the values on the graph are only shown when you hover above the corresponding part of the graph?
Thanks for your help!
Oliver
Addition:
What I want to do:
Read out all the values for tag “span” to a worksheet in excel. Each value should be written in consecutive cell in the worksheet, i.e. A2, A3, ….
What the macro does:
Reads out the values for tag “span” for the first 4 rows then delivers 11 rows with no values and then again shows the remaining values of the website for the element “span”. I assume that in the 11 empty rows the numbers to the graph (this is what I need) would be shown, if the macro would work correctly. I have also attached a screenshot of the read out results to this post:
Read Out Results Excel Worksheet
There is a wait needed before download is pulling from that page.
Also, it would be better to target specific spans e.g.
Dim values As webelements, labels As webelements, r As Long
Set values = chromebrowser.FindElementsByCss(".dontshow span")
Set labels = chromebrowser.FindElementsByCss(".series span")
r = 0
For i = 1 To labels.Count Step 2
Debug.Print labels.Item(i).Text
Debug.Print values(i).Text
Debug.Print values(i + 1).Text
r = r + 1
Next
However, data comes from a csv that you can download. The csv has a timestamp parameter which may help with caching. I doubt server does much with it. #TimWilliams wrote a very nice little function to generate unix timestamps which you can use to construct the csv download url.
So, if there is other stuff you want on that page you can just chromebrowser.get to the constructed url and it will download:
Public Sub GetCovidNumbers()
Dim downloadUrl As String
downloadUrl = "https://static.dwcdn.net/data/6E03v.csv?v=" & CStr(toUnix(Now))
Debug.Print downloadUrl
'd.get downloadUrl
End Sub
Public Function toUnix(dt) As Long
'https://stackoverflow.com/a/12326121 #TimWilliams
toUnix = DateDiff("s", "1/1/1970", dt)
End Function
Or, if you only need that, you can set a download path and use urlmon to download from constructed url e.g.
Public Const folderName As String = "C:\Users\<user>\Desktop\covid.csv" '<=Change as required
Public Sub downloadCSV()
Dim ret As Long
ret = URLDownloadToFile(0, "https://static.dwcdn.net/data/6E03v.csv?v=" & CStr(toUnix(Now)), folderName, BINDF_GETNEWESTVERSION, 0)
End Sub
In all cases, you need to tidy up the headers in output and the age category 5-9. I would simply ignore those as they are constants so you can have them stored elsewhere.
Related
I've got an excel macro which is reading XML values from one file and replicating them in a second. I can't just copy files, as the second file has more and different stuff in it, and the user input determins what is being mapped. E.g. to use the classic example of a movie database, the user picks which genres to copy from source to target. I need to maps specific values across; the XPaths of the source and target are in a spreadsheet. Not all of the tags exist in the new XML file, so they need to be created my my code before their values can be populated.
I've got a great start from Greg-R's work at Create xml file based on xPath from Excel with VBA ; but his code doesn't handle numbered nodes. I've easily stripped the number from the target tag, but can't figure out the correct methods for adding the attribute to the node.
E.g. the XPath could be //Movies/Title[#number=1]/Actor[#number=5].Name
Here's what I've got so far:
Sub makeXPath(xmldoc As Object, xpath As String)
'Original code from: https://stackoverflow.com/questions/12149941/create-xml-file-based-on-xpath-from-excel-with-vba
Dim partsOfPath() As String
Dim oNodeList As IXMLDOMNodeList
Dim strXPathQuery As String
Dim sParent As String
Dim objRootElem As IXMLDOMElement
Dim objMemberElem As IXMLDOMElement
Dim objMemberName As IXMLDOMElement
Dim objParent As Object
Set objParent = xmldoc
partsOfPath = Split(xpath, "/")
For i = LBound(partsOfPath) To UBound(partsOfPath)
If strXPathQuery > "" Then strXPathQuery = strXPathQuery & "/"
strXPathQuery = strXPathQuery & partsOfPath(i)
Set oNodeList = xmldoc.SelectNodes(strXPathQuery)
If oNodeList.Length = 0 Then
'if I don't have the node, create it
Debug.Print "partsOfPath(" & i & ") = " & partsOfPath(i)
NumberPos = InStr(partsOfPath(i), "[#number=")
If NumberPos > 0 Then
'Numbered node, extract the number
ElementName = Left(partsOfPath(i), NumberPos - 1)
'Len("[#number=") = 9. Speed the code up by not calculating it each time. Every little bit helps!
NodeNumber = Mid(partsOfPath(i), NumberPos + 9, Len(partsOfPath(i)) - NumberPos - 9)
Else
ElementName = partsOfPath(i)
NodeNumber = ""
End If
Set objMemberElem = xmldoc.createElement(ElementName)
objParent.appendChild objMemberElem
If Not NodeNumber = "" Then
objMemberElem.createAttribute ("number") '<<<------ This bit is throwing errors :(
.createAttribute ("number")
objParent.Attributes.setNamedItem(objAttr).Text = NodeNumber
End If
'setting the parent for the next element of the path
Set objParent = objMemberElem
Else
'setting parent to first iteration, until I make adjustment otherwise later
Set objParent = oNodeList.Item(0)
End If
Next
End Sub
I've researched this til I'm blind (How many tabs can Chrome handle?) and tried various methods, but none are working. What are the methods I should be using?
Thanks for your help legends!
Just like createElement, createAttribute is a method of the xml document, not of a node like objMemberElem.
This should work:
If Not NodeNumber = "" Then
Set objAttr = xmldoc.createAttribute("number")
objAttr.Value = NodeNumber
objMemberElem.Attributes.setNamedItem objAttr
End If
I am new to Excel VBA. I have written some code with the help of online videos but I am stuck to resolve a problem of selecting two cells as Range values separated by commas. However, If I just use one of the selected cells, the compiling error does not occur.
Sub elevation_finder()
Dim elevation As Long
Dim ieobject As InternetExplorer
Dim htmlElement As IHTMLElement
Dim i As Integer
i = 1
Set ieobject = New InternetExplorer
ieobject.Visible = True
ieobject.navigate "https://www.freemaptools.com/elevation-finder.htm"
Application.Wait Now + TimeValue("00:00:05")
ieobject.document.getElementById("locationSearchTextBox").Value = ActiveWorkbook.Sheets("Header").Range("C2").Value
End Sub
My next step after entering the numbers (coordinates as integers) is to import the result back into new column.
Help and suggestion is appreciated to improve the code in automating the coordinates to find respective elevations.
enter image description here
Kind regards.
Should be able to use something like:
With ActiveWorkbook.Sheets("Header")
ieobject.document.getElementById("locationSearchTextBox").Value = _
.Range("B2").Value & "," & .Range("C2").Value
End with
Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Caption = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.
When I try to write something from the method given by EPPlus i.e. It comes up with two error messages
We have found a problem with some content
Excel completed file level validation and repair. some parts of this workbook may have been repaired or discarded.
Excel opens successfully but, with error messages and one more thing excel I'm writing is already written that means it is a template.
Dim consh As ExcelWorksheet
'Dim excelStream As New MemoryStream()
'excelStream.Write(excel, 0, excel.Length)
Dim exlpck As New ExcelPackage(excel)
If exlpck.Workbook.Worksheets(cellExcelTabName) Is Nothing Then
consh = exlpck.Workbook.Worksheets.Add(cellExcelTabName)
Else
consh = exlpck.Workbook.Worksheets(cellExcelTabName)
End If
Dim start = consh.Dimension.Start
Dim [end] = consh.Dimension.[End]
For row As Integer = 4 To [end].Row
' Row by row...
For col As Integer = 18 To 35
' ... Cell by cell...
' This got me the actual value I needed.
Dim cellValue As String = consh.Cells(row, col).Text
Dim cellAddress = consh.Cells(row, col).Address
Dim i = 0
For Each mText In textToFind
If cellValue.Contains(mText) Then
consh.Cells(cellAddress).Value = cellValue.Replace(mText, "")[enter image description here][1]
consh.Cells(cellAddress).Style.Fill.PatternType = ExcelFillStyle.Solid
consh.Cells(cellAddress).Style.Fill.BackgroundColor.SetColor(color(mText.Substring(1, 1) - 1))
i = i + 1
End If
Next
Next
Next
'Dim exlpck1 As New ExcelPackage(e)
exlpck.Save()
Dim s = New MemoryStream(exlpck.GetAsByteArray())
Return s
As stated here ("I get an error that Excel has found unreadable content ..."), the EPPlus Package does not validate formulas and number formats. You might want to check there for hints.
I found the fix for my code
exlpck.Save()
to be Replaced by
exlpck.SaveAs(ms)
And it worked :)
I have a long list of origins and destinations in Excel, using webquery I can fill in the cities and postal code to give a webquery like:
http://maps.googleapis.com/maps/api/directions/xml?origin=Scoresby&destination=Melborne&sensor=false
This returns me a long XML file, but all I need is just the distance. Is there a way to extract only the distance value?
Or should I just run a macro script to extract distance one by one? (Since the format remains roughly the same each time I ask the server)
The short answer is XPath - well worth learning if you are going to work with any kind of XML
In the macro editor in Excel, go to Tools > References and add a reference to "Microsoft XML, v6.0" Now Insert > Module and add this code:
Sub getDistances()
Dim xhrRequest As XMLHTTP60
Dim domDoc As DOMDocument60
Dim ixnlDistanceNodes As IXMLDOMNodeList
Dim ixnNode As IXMLDOMNode
Dim lOutputRow As Long
' Read the data from the website
Set xhrRequest = New XMLHTTP60
xhrRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=Scoresby&destination=Melborne&sensor=false", False
xhrRequest.send
' Copy the results into a format we can manipulate with XPath
Set domDoc = New DOMDocument60
domDoc.loadXML xhrRequest.responseText
' The important bit: select every node called "value" which is the child of a node called "distance" which is
' in turn the child of a node called "step"
Set ixnlDistanceNodes = domDoc.selectNodes("//step/distance/value")
' Basic stuff to output the distances
lOutputRow = 1
With Worksheets("Sheet1")
.UsedRange.ClearContents
For Each ixnNode In ixnlDistanceNodes
.Cells(lOutputRow, 1).Value = ixnNode.Text
lOutputRow = lOutputRow + 1
Next ixnNode
End With
Set ixnNode = Nothing
Set ixnlDistanceNodes = Nothing
Set domDoc = Nothing
Set xhrRequest = Nothing
End Sub
To extend this to cover multiple trips you would just loop through the required origins and destinations, pass each pair as parameters to this procedure and then output the results in whichever format you need