I have a column of hyperlinks in an Excel file and I want to convert them to their respective HTML code:
Link Name
I found ways to extract the link only (as text), but I need the whole HTML code as text to replace the hyperlink in the cell.
I've searched and searched but no one needed this answer, I guess. Can someone help?
It is actually a fairly straightforward method to yank the .Address and optional .SubAddress from the Hyperlinks collection object. The .TextToDisplay property is simply the value or text of the cell.
Sub html_anchors()
Dim a As Range, u As String, l As String
Dim sANCHOR As String: sANCHOR = "%L%"
For Each a In Selection
With a
If CBool(.Hyperlinks.Count) Then
l = .Text
u = .Hyperlinks(1).Address
If Right(u, 1) = Chr(47) Then u = Left(u, Len(u) - 1)
.Hyperlinks(1).Delete
.Value = Replace(Replace(sANCHOR, "%U%", u), "%L%", l)
End If
End With
Next a
End Sub
Select all of the cells you want to process and run the routine. If any cell in your selection does not contain a hyperlink, it will be ignored.
Related
My goal is to fill a LibreOffice calc sheet, and silently send a cell range by email when the user clicks the send-off button (and once more to confirm).
So there is three part to this.
A push button with a request to confirm. (Easy and done.)
Select Cell Range and turn it into rich text format (Haven't yet found)
Send rich text email from within the sheet. (Will tackle the "silent" part later)
I tried copying the range to the clipboard with unoService but it seemed over-complicated and full of errors.
Here's what I have:
''''Send by e-mail enriched text
Sub Main
Dim Doc, Sheet, Range, Rtf, Exec as Object
End Sub
'Confirm it
Sub SendTableApproval
If MsgBox ("Ready to email?", MB_YESNO + MB_DEFBUTTON2) = IDYES Then
CopyTable()
End If
End Sub
'Copy it
Sub CopyTable
Doc = ThisComponent
View = Doc.CurrentController
Frame = View.Frame
Sheet = Doc.Sheets.getByIndex(0)
Range = Sheet.getCellrangeByName("a1:f45")
Exec = createUnoService("com.sun.star.frame.DispatchHelper")
View.Select(Range)
Cells = View.getTransferable()
Exec.executeDispatch(Frame, ".uno:Deselect", "", 0, array())
'SimpleMailTo(Cells)
End Sub
'Mail it
Sub SimpleMailTo(body)
Dim launcher as object
Dim eAddress, eSubject, eBody, aHTMLanchor as string
launcher = CreateUnoService("com.sun.star.system.SystemShellExecute")
eAddress = "tu#domo.eg"
eSubject = "Cotidie agenda futuendane"
eBody = body
aHTMLanchor = "mailto:" & eAddress & "?subject=" & eSubject & "&&body=" & eBody
launcher.execute(aHTMLanchor, "", 0)
End Sub
I still do not know after three days of research over methods, properties, uno.
My question is, simply put, How can I convert a transferable content to HTML/RTF?
Simply copying and pasting into an email produces the result you are asking for. The code on the LibreOffice side should look like this.
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
It sounds like you already tried this, but something didn't work. Perhaps you could elaborate on what went wrong.
Another approach would be to write the spreadsheet to a temporary HTML or XHTML file. Then parse the temporary file to grab the part needed for the email.
AFAIK there is no such command to turn a cell range into rich text format with UNO. To do it that way, you would need to loop through each text range of each cell, read its formatting properties and then generate the HTML yourself.
EDIT:
Good idea about XTransferable. The following Java code adapted from the DevGuide gets an HTML string and then prints it. I believe this would be a good solution for your needs.
public void displayHTMLFromClipboard()
{
try
{
Object oClipboard = xMCF.createInstanceWithContext(
"com.sun.star.datatransfer.clipboard.SystemClipboard", xContext);
XClipboard xClipboard = (XClipboard)
UnoRuntime.queryInterface(XClipboard.class, oClipboard);
XTransferable xTransferable = xClipboard.getContents();
DataFlavor[] aDflvArr = xTransferable.getTransferDataFlavors();
System.out.println("Available clipboard formats:");
DataFlavor aChosenFlv = null;
for (int i=0;i<aDflvArr.length;i++)
{
System.out.println(
"MimeType: " + aDflvArr[i].MimeType +
" HumanPresentableName: " + aDflvArr[i].HumanPresentableName );
if (aDflvArr[i].MimeType.equals("text/html"))
{
aChosenFlv = aDflvArr[i];
}
}
System.out.println("");
try
{
if (aChosenFlv != null)
{
System.out.println("HTML text on the clipboard...");
Object aData = xTransferable.getTransferData(aChosenFlv);
String s = new String((byte[])aData, Charset.forName("ISO-8859-1"));
System.out.println(s);
}
}
catch (UnsupportedFlavorException exc)
{
exc.printStackTrace();
}
}
catch(com.sun.star.uno.Exception exc)
{
exc.printStackTrace();
}
}
If you plan to use Basic, it might be a good idea to do some research into the proper way to convert bytes. The code I have below seems to work but is probably unreliable and unsafe, and will not work for many languages. A few of my initial attempts crashed before this finally worked.
Sub DisplayClipboardData
oClipboard = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
xTransferable = oClipboard.getContents()
aDflvArr = xTransferable.getTransferDataFlavors()
For i = LBound(aDflvArr) To UBound(aDflvArr)
If aDflvArr(i).MimeType = "text/html" Then
Dim aData() As Byte
aData = xTransferable.getTransferData(aDflvArr(i))
Dim s As String
For j = LBound(aData) to UBound(aData)
s = s & Chr(aData(j)) 'XXX: Probably a bad way to do this!
Next j
Print(s)
End If
Next
End Sub
One more suggestion: Python might be a better language choice here. In many ways, using Python with LibreOffice is easier than Java. And unlike Basic, Python is powerful enough to comfortably handle byte strings.
I want to use VBA (or some other solution) to conditionally change the background color of a form based off what number users enter in a numeric field. Basically, after they enter their answer to the Starter question, if they entered 1 then I want the form background to change to a specific shade of blue, and if they entered 2 then I want the form background to change to a specific shade of green. I saw a code that looks like it would be very similar to my need in another question on here, but I couldn't figure out how to make the code work, and was having trouble figuring out exactly how/where to put each module.
Some information:
The field I want it to be based off of is numeric, called Starter, and through data validation users are limited to entering 1, 2, 9, or leaving it blank. I only want the color to change if it's entered as 1 or 2.
I'm using Access 2010
the form has neither header nor footer
the code I was attempting to use and made some alterations to is the following:
Private Sub Form_AfterUpdate()
blue_yes = "15325906"
green_no = "13888226"
Dim colorThis As String
booWhatever = Me.Starter ''Use of the variable can prevent problems
If booWhatever = 1 Then
colorThis = "blue_yes"
End If
If booWhatever = 2 Then
colorThis = "green_no"
End If
subFrm.Form.Section(acDetail).BackColor = colorThis
subFrm.Form.Repaint
End Sub
I've also managed, off a very different piece of code, to sort of do what I want, but the way it's working it seems to change the status of all forms, not just the one I'm currently working with, which is the goal. So for example if I enter 2 to starter, it changes the background color of every single record's form.
Private Sub Starter_AfterUpdate()
If Me.Starter = "1" Then Me.Detail.BackColor = vbBlue
If Me.Starter = "2" Then Me.Detail.BackColor = vbGreen
End Sub
EDIT:
Welp, embarrassingly I found the solution. It's not a very neat one, but it works.
Private Sub Form_Current()
Dim Presence As String
Presence = Nz(Me.Starter.Value, 9)
Select Case Presence
Case "1"
Me.Detail.BackColor = 15325906
Case "2"
Me.Detail.BackColor = 13888226
Case Else
Me.Detail.BackColor = vbWhite
End Select
End Sub
Private Sub Starter_AfterUpdate()
Dim Presence As String
Presence = Nz(Me.Starter.Value, 9)
Select Case Presence
Case "1"
Me.Detail.BackColor = 15325906
Case "2"
Me.Detail.BackColor = 13888226
Case Else
Me.Detail.BackColor = vbWhite
End Select
End Sub
I know it is a really old question (probably you have already solved it in a better way) but I will give it a try anyways.
Try the following:
Private Sub Text0_Change()
Select Case Me.Text0.Text
Case ""
Case "1"
Me.Detail.BackColor = 15325906
Case "2"
Me.Detail.BackColor = 13888226
Case Else
Me.Detail.BackColor = vbWhite
End Select
End Sub
EDIT:
I tried that and it works I think now as it supposed to do.
When you change the text on the text box triggers this event every time, runs the Sub, checks it's own text and changes the color of the form as described.
The change is that I changed the property of the field it checks. From Value to Text. We want when the event triggers to check the current text because the Value property updates when you "finish" with the textbox (after you press enter or the focus on the control is lost) and we want the change to happen the same moment we press the key changing the value and not later.
The second change and the reason we got strange patterns before is that I have added one more Case when the text is "" to do nothing on that change (empty case). Without that case when we used delete or backspace to remove the text and left the textbox empty ("") then the case else was True and it changed the background color.
I hope this is the correct answer now. Please let me know!
So, I am trying to get a date out of html using VBA in Excel, and I am having issues finding a way to extract the text that I want it appears as:
<SPAN id=ctl00_ContentPlaceHolder1_lblDateCreated2>5/22/2012 8:14:08 PM</SPAN>
I want extract the 5/22/2012 8:14:08, but as it is not a string and in between the carats, I don't know exactly how to do it. Any tips?
I figured out that I was using ".innerText" incorrectly, and I was able to get it working with the following snippet.
Doc.getElementById("ctl00_ContentPlaceHolder1_lblDateCreated2").innerText
You could do this in VBA with split:
theString = "<SPAN id=ctl00_ContentPlaceHolder1_lblDateCreated2>5/22/2012 8:14:08 PM</SPAN>"
Temp = Split(theString, "ContentPlaceHolder1_lblDateCreated2>")(1)
Final = Split(Temp, "</")(0)
The first Split will return an array of two parts:
Temp(0) = "<SPAN id=ctl00_"
Temp(1) = "5/22/2012 8:14:08 PM</SPAN>"
Next we Split Temp(1) to remove the closing SPAN tag and return just the date and time.
I think you're just looking for a Mid() formula. If that URL/Span part in A1, put this in A2 (or wherever):
=MID(A1,SEARCH(">",A1)+1,FIND("</",A1)-FIND(">",A1)-1)
I am looking for a way to replace keywords within a html string with a variable. At the moment i am using the following example.
returnString = Replace(message, "[CustomerName]", customerName, CompareMethod.Text)
The above will work fine if the html block is spread fully across the keyword.
eg.
<b>[CustomerName]</b>
However if the formatting of the keyword is split throughout the word, the string is not found and thus not replaced.
e.g.
<b>[Customer</b>Name]
The formatting of the string is out of my control and isn't foolproof. With this in mind what is the best approach to find a keyword within a html string?
Try using Regex expression. Create your expressions here, I used this and it works well.
http://regex-test.com/validate/javascript/js_match
Use the text property instead of innerHTML if you're using javascript to access the content. That should remove all tags from the content, you give back a clean text representation of the customer's name.
For example, if the content looks like this:
<div id="name">
<b>[Customer</b>Name]
</div>
Then accessing it's text property gives:
var name = document.getElementById("name").text;
// sets name to "[CustomerName]" without the tags
which should be easy to process. Do a regex search now if you need to.
Edit: Since you're doing this processing on the server-side, process the XML recursively and collect the text element's of each node. Since I'm not big on VB.Net, here's some pseudocode:
getNodeText(node) {
text = ""
for each node.children as child {
if child.type == TextNode {
text += child.text
}
else {
text += getNodeText(child);
}
}
return text
}
myXml = xml.load(<html>);
print getNodeText(myXml);
And then replace or whatever there is to be done!
I have found what I believe is a solution to this issue. Well in my scenario it is working.
The html input has been tweaked to place each custom field or keyword within a div with a set id. I have looped through all of the elements within the html string using mshtml and have set the inner text to the correct value when a match is found.
e.g.
Function ReplaceDetails(ByVal message As String, ByVal customerName As String) As String
Dim returnString As String = String.Empty
Dim doc As IHTMLDocument2 = New HTMLDocument
doc.write(message)
doc.close()
For Each el As IHTMLElement In doc.body.all
If (el.id = "Date") Then
el.innerText = Now.ToShortDateString
End If
If (el.id = "CustomerName") Then
el.innerText = customerName
End If
Next
returnString = doc.body.innerHTML
return returnString
Thanks for all of the input. I'm glad to have a solution to the problem.
Here's my problem. I am passing in a parameter let say it's called ShapesSelected.
ShapeSelected = ",Square, Triangle, Circle,".
The problem is ShapeSelected could be any of the the shapes so it is never static.
Base on this parameter I want to add 3 column to the right of a table in the report. Is this possible? I've starting coding it in Custom Code in Report Properties but I am stuck as in how to add the column.
Public Function GetReportShapes( ByVal ShapesSelected As String )
Dim Shapes() As String
Dim result As String
Dim i As Integer
Entities = Split(ShapesSelected ,", ")
For i = 0 To UBound ( Shapes)
Select case Shapes(i)
case "Square": 'add Square Column here
case "Rectangle": add Rectange Column here
case "Triangle": add Triangle Column here
End Select
Next i
End Function
Thus rendering the columns like this:
Square Triangle Circle
Add all the columns you need and use the hidden or visible property (I forget which) with vb expressions to turn them on and off.