I need to copy/store a string of text into the clipboard but need that text to be formatted (font type, color, weight, etc.)
Private Sub copyToCB(varText As String)
Dim x As Variant
x = varText
CreateObject("htmlfile").parentWindow.clipboardData.setData "text", x
End Sub
The above does the job of storing the referred text into the clipboard but it's stored as plain text. I'd like it to be e.g. bold and red.
I've been scouring the Internet literally for hours, to no avail. You'd think this would be something straightforward but I'm at a total loss!
If you use the clipboard classes from #GMCB found at https://stackoverflow.com/a/63735992/478884
You can do this:
Sub TestCopying()
CopyWithSomeFormatting "This should paste as red/bold"
End Sub
Sub CopyWithSomeFormatting(txt As String)
Dim myClipboard As New vbaClipboard 'Instantiate a vbaClipboard object
myClipboard.SetClipboardText _
"<span style='color:#F00;font-weight:bold'>" & txt & "</span>", "HTML Format"
End Sub
Works for me at least when pasting to Word/Excel
Related
I have an MS Word document with a three-column header like in the screenshot below.
Please advise a VBA macro to get the text in each of the columns (in my case "foo", "bar" and "baz").
So far I have tried
Sub Test()
MsgBox Documents(1).Sections(1).Headers(wdHeaderFooterPrimary).Range.Text
End Sub
enter code here
, but it returns text with zeros ("foo0bar0baz"), which seems not to be suitable to break this text in general case, when the column texts themselves can contain zeros (e.g. "foo0", "0bar00" and "0baz").
You use the Split function to create an array of the text. You will need to know what character has been used to separate the columns. It will probably be either a normal tab or an alignment tab.
For a normal tab:
Sub SplitHeader()
Dim colHeads As Variant
colHeads = Split(ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text, vbTab)
Debug.Print colHeads(0)
Debug.Print colHeads(1)
Debug.Print colHeads(2)
End Sub
For an alignment tab:
Sub SplitHeader()
Dim colHeads As Variant
colHeads = Split(ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text, Chr(48))
End Sub
I have to program something quickly for my colleagues, and I've been stuck for a while on the following. The goal is to use data from MS Excel to fill in a MS Word template. It is this latest I have issues with.
The MS Word template is as follow:
The idea would be to search on the left column (so for example Organism), take that line and replace the right (Click here to enter text) with the corresponding value from MS Excel. But I'm new in VBA and I'm unsure how to correctly program this. The code I have for the moment is this one, which finds the correct left string, and replaces that with the string + MS Excel value, but not replacing in the right column.
Sub SearchAndReplace(inputKey As String, inputVar As String)
With Selection.Find
.Text = inputKey
.Replacement.Text = inputVar
.Execute Replace:=wdReplaceOne, Forward:=True, _
Wrap:=wdFindStop
End With
End Sub
Help would be very much appreciated. If something is not clear please feel free to ask.
Thank you in advance.
The screenshot you have posted does not make clear whether the items are in a table, but it does show that there are content controls.
If you have set up the content controls correctly with titles and/or tags then you can use something like this:
Sub AddTextToContentControl(targetDoc As Document, ccTitle As String, textToAdd As String)
Dim ctrl As ContentControl
Set ctrl = targetDoc.SelectContentControlsByTitle(ccTitle).Item(1)
ctrl.Range.Text = textToAdd
End Sub
Sub AddTextToContentControlByTag(targetDoc As Document, ccTag As String, textToAdd As String)
Dim ctrl As ContentControl
Set ctrl = targetDoc.SelectContentControlsByTag(ccTag).Item(1)
ctrl.Range.Text = textToAdd
End Sub
I have a rich text content control called TestContent. Example:
In my code the sub RunExample initialized the range of said content control and writes the example text into the end of the range using AddText sub:
Option Explicit
Dim TestContentRange As Word.Range
Sub RunExample()
'Initialize the range as the range of Content Control
Set TestContentRange = ActiveDocument.SelectContentControlsByTitle("TestContent")(1).Range
'Write the "Hello World" to the content Control
AddText "Hello World"
End Sub
Sub AddText(TextBit As String)
Dim SlaveRange As Word.Range
Set SlaveRange = TestContentRange
SlaveRange.Collapse Direction:=wdCollapseEnd
SlaveRange.Text = TextBit
End Sub
I get Runtime error 6124 : You are not allowed to edit this selection because it is protected.
As I understand the reason for this is because when the content control is empty the placehorlder text gets in the way. And the placeholder is prohibited from direct editing hence the error. For example if I put some text into the Content Control like TestContentRange.Text = "!" the code runs fine. Example:
Option Explicit
Dim TestContentRange As Word.Range
Sub RunExample()
Set TestContentRange = ActiveDocument.SelectContentControlsByTitle("TestContent")(1).Range
TestContentRange.Text = "!"
AddText "Hello World"
End Sub
Sub AddText(TextBit As String)
Dim SlaveRange As Word.Range
Set SlaveRange = TestContentRange
SlaveRange.Collapse Direction:=wdCollapseEnd
SlaveRange.Text = TextBit
End Sub
My question is - how do I avoid that placeholder text? Should I make a check of the range being empty in the AddText sub or is there a better way?
My understanding of your question is that you want to either replace or add to the text of a content control, depending on the existing text in the control.
To check if a content control still contains its placeholder text simply compare the controls Range.Text to its PlaceholderText property. To do that your AddText routine needs to work with the actual content control not just its range.
Sub RunExample()
AddTextToContentControl ActiveDocument, "Test Content", "Hello World"
End Sub
Sub AddTextToContentControl(WorkDoc As Document, CCTitle As String, TextToAdd As String)
Dim ctrl As ContentControl
Set ctrl = GetContentControlByTitle(WorkDoc, CCTitle)
If Not ctrl Is Nothing Then
If ctrl.Range.Text = ctrl.PlaceholderText Then
'replace the placeholder text
ctrl.Range.Text = TextToAdd
Else
'add to the existing text
ctrl.Range.Text = ctrl.Range.Text & " " & TextToAdd
End If
End If
End Sub
Function GetContentControlByTitle(SearchDoc As Document, CCTitle As String) As ContentControl
Dim ctrl As ContentControl
For Each ctrl In SearchDoc.ContentControls
If ctrl.Title = CCTitle Then
Set GetContentControlByTitle = ctrl
Exit For
End If
Next
End Function
Because you're collapsing the range, the macro tries to append your text to the default text in the CC, which is not possible. Just take out this line:
SlaveRange.Collapse Direction:=wdCollapseEnd
Then it runs as expected and replaces the default.
I suggest something that makes use of .ShowingPlaceholderText, e.g. :
' This assumes there is at least one CC titled "TestContent"
With ActiveDocument.SelectContentControlsByTitle("TestContent")(1)
If .ShowingPlaceholderText Then
.Range.Text = "Hello World"
Else
.Range.InsertAfter "Hello World"
End If
End With
Otherwise, a design problem occurs if the CC currently contains text that is identical to the placeholder text. Do you want text that is identical to the placeholder text, but is real text, to be replaced as if it was actually placeholder text, or do you want to append "Hello World" ?
To summarize what I'm attempting to do, I work for a non-profit organization that sends out acknowledgement letters when someone donates money to us (a thank you, basically). We have multiple different letters that are written every month and sent to IS to "process". I would like to make this as efficient and use as little time as possible for IS, so I've created a program in VB.NET that takes content and pastes it into a template using Word bookmarks, updates a table in SQL so that the letter can be tested with live data, and sends an e-mail to the Production department letting them know to test the letter. It works fully, except...
I cannot for the life of me figure out how to retain RTF (RichText) when I insert the content into the letter template.
I've tried saving the content of the RichTextBox as an RTF file, but I can't figure out how to insert the RTF file contents into my document template and replace the bookmark.
I've tried using the Clipboard.SetText, odoc......Paste method, but it's unreliable as I can't accurately state where I'd like the text to paste. The find/replace function isn't very helpful because all of the bookmarks I'm trying to replace are within text boxes.
I'd show some code, but most of it has been deleted out of frustration for not working. Either way, here's some code I've been working with:
Private Sub testing()
strTemplateLocation = "\\SERVER\AcknowledgementLetters\TEST\TEMPLATE.dot"
Dim Selection As Word.Selection
Dim goWord As Word.Application
Dim odoc As Word.Document
goWord = CreateObject("Word.Application")
goWord.Visible = True
odoc = goWord.Documents.Add(strTemplateLocation)
Clipboard.Clear()
Clipboard.SetText(txtPreD.Rtf, TextDataFormat.Rtf)
odoc.Content.Find.Execute(FindText:="<fp>", ReplaceWith:=My.Computer.Clipboard.GetText)
'Code for looping through all MS Word Textboxes, but didn't produce desired results
For Each oCtl As Shape In odoc.Shapes
If oCtl.Type = Microsoft.Office.Core.MsoShapeType.msoTextBox Then
oCtl.TextFrame.TextRange.Text.Replace("<fp>", "Test")
goWord.Selection.Paste()
End If
Next
'Clipboard.Clear()
'Clipboard.SetText(txtPostD.Rtf, TextDataFormat.Rtf)
'odoc.Content.Find.Execute(FindText:="<bp>", ReplaceWith:="")
'goWord.Selection.Paste()
MsgBox("Click Ok when finished checking.")
odoc.SaveAs2("\\SERVER\AcknowledgementLetters\TEST\TEST.docx")
odoc = Nothing
goWord.Quit(False)
odoc = Nothing
goWord = Nothing
End Sub
...and here is the default code for setting bookmarks. This works perfectly as long as formatting is not required:
Private Sub SetBookmark(odoc As Object, strBookmark As String, strValue As String)
Dim bookMarkRange As Object
If odoc.Bookmarks.Exists(strBookmark) = False Then
Exit Sub
End If
bookMarkRange = odoc.Bookmarks(strBookmark).Range
If ((Err.Number = 0) And (Not (bookMarkRange Is Nothing))) Then
bookMarkRange.text = strValue
odoc.Bookmarks.Add(strBookmark, bookMarkRange)
bookMarkRange = Nothing
End If
End Sub
TL;DR - Need formatted text (Example: "TEST") to be inserted into a Word document either as a bookmark or as a replacement text.
Expected results: Replace "fp" (front page) bookmark with "TEST" including bold formatting.
Actual results: "fp" is not replaced (when using clipboard and find/replace method), or is replaced as "TEST" with no formatting.
I figured it out! I had to do it a weird way, but it works.
The following code saves the RichTextBox as an .rtf file:
RichTextBoxName.SaveFile("temp .rtf file location")
I then used the following code to insert the .rtf file into the bookmark:
goWord.ActiveDocument.Bookmarks("BookmarkName").Select()
goWord.Selection.InsertFile(FileName:="temp .rtf file location")
I then deleted the temp files:
If My.Computer.FileSystem.FileExists("temp .rtf file location") Then
My.Computer.FileSystem.DeleteFile("\temp .rtf file location")
End If
I have an Excel .xlam file that adds a button in the ribbon to do the following:
Scan the ActiveSheet for some pre-set parameters
Take my source text (a string value, hard coded directly in a VBA Module) and replace designated areas with the parameters retrieved from step 1
Generate a file containing the calculated text
I save the source text this way because it can be password protected and I don't need to drag another file around everywhere that the .xlam file goes. The source text is saved in a separate module called "Source" that looks something like this (Thanks VBA for not having Heredocs):
'Source Module
Public Function GetSource() As String
Dim s As String
s = ""
s = s & "This is the first line of my source text" & vbCrLf
s = s & "This is a parameter {par1}" & vbCrLf
s = s & "This is another line" & vbCrLf
GetSource = s
End Function
The function works fine. My problem is if I want to update the source text, I now have to manually do that in the .xlam file. What I would like to do is build something like a Sub ImportSource() in another module that will parse some file, rebuild the "Source" Module programatically, then replace that Module with my calculated source code. What I don't know is if/how to replace the source code of a module with some value in a string variable.
It's like metaprogramming at its very worst and philosophically I'm against doing this down to my very core. Practically, however, I would like to know if and how to do it.
I realize now that what you really want to do is store some values in your document in a way that is accessible to your VBA, but that is not readable to a user of the spreadsheet. Following Charles Williams's suggestion to store the value in a named range in a worksheet, and addressing your concern that you don't want the user to have access to the values, you would have to encrypt the string...
The "proper way" to do this is described in this article - but it's quite a bit of work.
A much shorter routine is found here. It just uses simple XOR encryption with a hard coded key - but it should be enough for "most purposes". The key would be "hidden" in your macro, and therefore not accessible to prying eyes (well, not easily).
Now you can use this function, let's call it encrypt(string), to convert your string to a value in the spreadsheet:
range("mySecretCell").value = encrypt("The lazy dog jumped over the fox")
and when you need to use it, you use
Public Function GetSource()
GetSource = decrypt(Range("mySecretCell").value)
End Function
If you use the XOR version (second link), encrypt and decrypt would be the same function...
Does that meet your needs better?
As #brettdj already pointed out with his link to cpearson.com/excel/vbe.aspx , you can programmatically change to code of a VBA module using the VBA Extensibility library! To use it, select the library in the VBA editor Tools->References. Note that you need to also change the options in your Trust center and select: Excel Options->Trust Center->Trust Center Settings->Macro Settings->Trust access to the VBA project object model
Then something like the following code should do the job:
Private mCodeMod As VBIDE.CodeModule
Sub UpdateModule()
Const cStrModuleName As String = "Source"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = Workbooks("___YourWorkbook__").VBProject
'Delete the module
VBProj.VBComponents.Remove VBProj.VBComponents(cStrModuleName)
'Add module
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = cStrModuleName
Set mCodeMod = VBComp.CodeModule
'Add procedure header and start
InsertLine "Public Function GetSource() As String"
InsertLine "Dim s As String", 1
InsertLine ""
'Add text
InsertText ThisWorkbook.Worksheets("Sourcetext") _
.Range("___YourRange___")
'Finalize procedure
InsertLine "GetSource = s", 1
InsertLine "End Function"
End Sub
Private Sub InsertLine(strLine As String, _
Optional IndentationLevel As Integer = 0)
mCodeMod.InsertLines _
mCodeMod.CountOfLines + 1, _
Space(IndentationLevel * 4) & strLine
End Sub
Private Sub InsertText(rngSource As Range)
Dim rng As Range
Dim strCell As String, strText As String
Dim i As Integer
Const cLineLength = 60
For Each rng In rngSource.Cells
strCell = rng.Value
For i = 0 To Len(strCell) \ cLineLength
strText = Mid(strCell, i * cLineLength, cLineLength)
strText = Replace(strText, """", """""")
InsertLine "s = s & """ & strText & """", 1
Next i
Next rng
End Sub
You can "export" and "import" .bas files programmatically. To do what you are asking, that would have to be the approach. I don't believe it's possible to modify the code in memory. See this article