How to add character in xml element - VBA - excel

Below is the XML Node. I am adding nodes like below..
<ANNEXURE_A>
<ANNX_A/>
</ANNEXURE_A>
But I want it like..
<ANNEXURE_A>
<ANNX_A id="1">
</ANNX_A>
</ANNEXURE_A>
How do I add id = "1" in element.
below is the code I am using:
Set nodElement = docXMLDOM.createElement("ANNEXURE_A")
Set docXMLDOM.DocumentElement = nodElement
For i = 1 To 10
Set nodChild = docXMLDOM.createElement("ANNX_A ID=" & """ & i & """)
nodElement.appendChild nodChild
Next i
docXMLDOM.Save path
Set docXMLDOM = Nothing
But it is throwing error This may not contain '=' character. How to I achieve this ?

You need to create the attribute independently:
For i = 1 To 10
Set nodChild = docXMLDOM.createElement("ANNX_A")
nodChild.setAttribute "ID", i
nodElement.appendChild nodChild
Next i

Related

Add single quotes around a word in an excel column

Currently the text in a cell looks like this-
UPDATE A SET group_name = B WHERE group_ID = C;
Formula used for this is-
="UPDATE "&$N$1&" SET "&$N$2&" = "&TEXT($B2,"MM/DD/YY")&"WHERE "&$N$3&" = "&$E2&";"
I want to add single quotes around B here so that it looks like this-
UPDATE A SET group_name = 'B' WHERE group_ID = C;
How do I achieve this by tweaking the above mentioned formula?
As commented few methods here. All following formulas should work for you.
="UPDATE "&$N$1&" SET "&$N$2&" = "&TEXT($B2,"'MM/DD/YY'")&" WHERE "&$N$3&" = "&$E2&";"
="UPDATE "&$N$1&" SET "&$N$2&" = '"&TEXT($B2,"MM/DD/YY")&"' WHERE "&$N$3&" = "&$E2&";"
="UPDATE "&$N$1&" SET "&$N$2&" = "& CHAR(39) & TEXT($B2,"MM/DD/YY") & CHAR(39) & " WHERE "&$N$3&" = "&$E2&";"

How to export text from annotation fields in Nuance Power PDF to Excel using VBA?

I am trying to export some text from annotation fields in Nuance Power PDF to Excel using VBA. I added the Nuance Power PDF reference to Excel VBA (PDF Plus).
I used it and it works well but the text returned from fields is empty.
Set PDFApp = CreateObject("NuancePDF.App")
Set dvDoc = CreateObject("NuancePDF.DVDoc")
dvDoc.Open("\\adpdc-2\Users$\a.goudinoux\Documents\Macro Formulaire\fiche.pdf")
Set ddDoc = dvDoc.GetDDDoc()
Set ddPage = ddDoc.AcquirePage(0)
nbannots = ddPage.GetNumAnnots() - 1
For i = 0 To nbannots
Texte = ""
Set ddAnnot = ddPage.GetAnnot(i)
Set ddText = ddDoc.CreateTextSelect(0, ddAnnot.GetRect())
ThisWorkbook.Sheets(1).Cells(1, i) = ddAnnot.GetTitle()
For k = 0 To ddText.GetNumText()
Texte = Texte & ddText.GetText(k)
Next
ThisWorkbook.Sheets(1).Cells(2, i) = Texte
Next
Part of the PDF document :
Results :
As you can see the first line is working but not the second one.
I thought the problem was with ddText but ddText.GetNumText() gives the right number of text elements in the text selection (ex : 2, 5, 4, etc...) when I run my program in Debug Mode.
I think the problem is from the function GetText(k).
I made it work once but I can't find my code back..
Do you see any mistake ?
Either your annotations are more complex than indicated or you're overthinking it.
Just read the annotation with GetContents and call it a day.
Set PDFApp = CreateObject("NuancePDF.App")
Set dvDoc = CreateObject("NuancePDF.DVDoc")
dvDoc.Open("\\adpdc-2\Users$\a.goudinoux\Documents\Macro Formulaire\fiche.pdf")
Set ddDoc = dvDoc.GetDDDoc()
Set ddPage = ddDoc.AcquirePage(0)
nbannots = ddPage.GetNumAnnots() - 1
For i = 0 To nbannots
Set ddAnnot = ddPage.GetAnnot(i)
ThisWorkbook.Sheets(1).Cells(1, i) = ddAnnot.GetTitle
ThisWorkbook.Sheets(1).Cells(2, i) = ddAnnot.GetContents
Next i

Load image to a label in userform using vba

I am working on a userform to load Images over labels, I am getting a
Run time error '75': Path/File access error
with below code,
dim solArr as variant
solArr = Split("1.jpg,2.jpg,3.jpg",",")
For i = LBound(solArr) To UBound(solArr)
'For rating image
Dim ratingImageName As String
ratingImageName = "D:\somepath" & "\" & solArr(i)
Set imageStar = UserForm1.Frame3.Controls.Add("Forms.Label.1")
imageStar.Top = 40 + (i * 50)
imageStar.Left = 420
imageStar.Height = 20
imageStar.Width = 100
imageStar.Picture = LoadPicture(ratingImageName)
Next
But, if i use ratingImageName as "D:\Somepath\1.jpg" no error is recieved...
Is there a better way to do it?
Hmmm.. solArr = Array("1.jpg","2.jpg","3.jpg")
I was picking up a value from cell as
1.jpg
2.jpg
3.jpg
the sentence replace(arrSol(i),chr(10),"") solved the problem.
Set imageStar = UserForm1.Frame3.Controls.Add("Forms.Label.1")
I have an array of many items in-game. Example item1, item2, item3... How to change index at item (Exemple item & i) and add a picture it item in label in Form.

VBA - trying to create XML based on multiple ranges

I am trying to create an output as a XML (save as text file + ".xml").
The layout of the XML is:
<file-info> (forsendelse)
<record-info>
..account#..
</record-info>
</file-info>
I have created a range of fields where the XML is written so that I can just "copy" from the spreadsheet into the text file.
I have tried the following:
With Worksheets("XML_generator")
Set forsendelse1 = .Range("G10:G31")
dat = forsendelse1.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set myrange1 = .Range("G32:G40")
dat = myrange1.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set myrange_acc = .Range("G41:G41")
dat = myrange_acc.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set myrange2 = .Range("G42:G73")
dat = myrange2.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set forsendelse2 = .Range("G74:G75")
dat = forsendelse2.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(FPath & "Request_" & FName & "_" & FDate & ".xml", True)
End With
When I do this I only get the last range ("forsendelse2") in my XML. Does anyone have an idea on how to get this to work?
Please note:
"..account#.." is just one cell in the workbook. This is the main
data to change between exports.
Not using the built in XML generator, since I require blank tags to be exported as well due to validation
Splitting into 5 is so that I going forward can add more than one "record1 + ..account#.. + record2"
In the future I wish the result to look something like this:
<file-info> (forsendelse)
<record-info>
..account#.. (i.e "A2" from sheet)
</record-info>
<record-info>
..account#.. (i.e "A3" from sheet)
</record-info>
</file-info>
But since I haven't tried to do the "while loop" on this yet, firstly I hope someone can help me fix my Range issue :)
Thank you for taking your time!
Best regards
Andreas Petersen
If you want to build up a string from multiple parts then you need to append each part, like this:
dat = "stack"
dat = dat & "overflow"
dat = dat & ".com"
The value of dat will now be "stackoverflow.com".
Your code is overwriting the existing value rather than appending to it:
dat = "stack"
dat = "overflow"
dat = ".com"
The value of dat will now be ".com"
Other issues:
it's not clear why you are creating multiple FileSystemObjects that don't get used (only the last one gets used for anything)
it may be easier to use MSXML2 and build a DOMDocument rather than trying to create the XML as a string

Smartart hierarchy nodes - can only fill in one textframe of each node

I am trying to build an organization chart automatically from data in Excel using Excel VBA. It works out fine, however, I would like to have both textframes filled in. In the big textframe I would like to have filled in the description of the department, and in the smaller textframe I would have like to add the department code.
smartart hierarchy layout
I can't find the code to access the smaller textframe.
Do While Source.Cells(Line, 1) <> ""
If Source.Cells(Line, 3) = PID Then
Set ParNode = QNode
If Source.Cells(Line, 4) = 1 Then
Set QNode = QNode.AddNode(msoSmartArtNodeDefault, msoSmartArtNodeTypeAssistant)
Else: Set QNode = QNode.AddNode(msoSmartArtNodeBelow)
End If
QNode.TextFrame2.TextRange.Text = Cells(Line, 6)
'here something needs to be added !!!
CurPid = Source.Cells(Line, 2)
If Not Found Then Found = True 'something was find
'Source.Rows(Line).Delete
'Line = Line + 1
Call AddChildNodes(QNode, Source, CurPid)
Debug.Print ("CurPid" & CurPid)
Debug.Print ("line" & Line)
Set QNode = ParNode
'ElseIf Found Then 'it's sorted,so nothing else can be found
' Exit Do
'Else
End If
Line = Line + 1
Loop
the upper line (where your CEO-text is)
QNode.TextFrame2.TextRange.Text
***.SmartArt.AllNodes(...).Shapes(1).TextFrame2.TextRange.Text
the lower line where your smartart is empty:
***.SmartArt.AllNodes(...).Shapes(2).TextFrame2.TextRange.Text
you need to check if QNode.Shapes(2).TextFrame2.TextRange.Text works. if not, you may need to use .parent

Resources