Convert CommentThreaded and replies to text - excel

I'm using Threaded Comments on my Excel workbooks. Most of them have multiple replies.
I want to convert the comments and replies to text.
I get the first comment using the function CommentThreaded.text but not the replies if any.
How to do it using VBA?

Here are some commands to work with threaded comments in VBA:
' To know if a cell has a threaded comment:
If Not Range("*c,r*").CommentThreaded Is Nothing Then
' To know if the threaded coment has replies:
Range("*c,r*").CommentThreaded. Replies.Count
' To add a threaded comment:
Range("*c,r*").AddCommentThreaded ("Add CommentThreaded")
' To response a threaded comment:
Range("*c,r*").CommentThreaded.AddReply ("*your reply here*")
' To resolve a threaded comment:
Range("*c,r*").CommentThreaded.Resolved = True
' To re-open a resolved threaded comment:
Range("*c,r*").CommentThreaded.Resolved = False
' To delete a threaded comment:
Range("*c,r*").CommentThreaded.Delete
' To get the author:
Range("*c,r*").CommentThreaded.Author.Name
' To get the date:
Range("*c,r*").CommentThreaded.Date
' To get the text on the cell where the threaded comment is:
Range("*c,r*").CommentThreaded.Parent
' To get the address where the threaded comment is:
Range("*c,r*").CommentThreaded.Parent.Address
' To get the text of the original comment:
Range("*c,r*").CommentThreaded.Text
' To get the text of the replies:
Range("*c,r*").CommentThreaded.Replies(*n*).text
' To get the replies author:
Range("*c,r*").CommentThreaded.Replies(*n*).Author.Name
' To get the date of the reply:
Range("*c,r*").CommentThreaded.Replies(*n*).Date
There is not too much information out there about threaded comments, so I hope this is useful.

I used Bernardo's list of commands to create my function (which also checks for Notes), and I'm sharing it in case anyone is looking for an already-complete solution:
Function UdfComment(rng As Range) As String
'This UDF returns a cell's Note or all its comments (prefixed by Date and Author Name).
'This UDF assumes the range is a single cell.
Application.Volatile
Dim str As String
'First, check for presence of Note (the thing that shows up when you press Shift+F2):
If Not rng.Comment Is Nothing Then
str = Trim(rng.Comment.Text)
'If the note has a standard name header on a separate line - if you want to remove it, uncomment this line:
'(to be safe, can delete the "- 1" at the end to prevent truncating if name header is NOT on a separate line)
'str = Right(str, Len(str) - InStr(1, str, ":") - 1)
'Notes and Comments seem to be mutually exclusive, so checking for comments in an "Else if":
ElseIf Not rng.CommentThreaded Is Nothing Then
'First, return the original comment (prefixed by date and author):
str = rng.CommentThreaded.Date & ", " & rng.CommentThreaded.Author.Name & ":" & vbNewLine & Trim(rng.CommentThreaded.Text)
'Now check if original comment has replies (if so, iterate through them and append them all to 'str'):
If rng.CommentThreaded.Replies.Count > 0 Then
For Each r In rng.CommentThreaded.Replies
str = str & vbNewLine & r.Date & ", " & r.Author.Name & ":" & vbNewLine & Trim(r.Text)
Next
End If
'Without notes and comments, simply return an empty string:
Else
str = ""
End If
UdfComment = str
End Function

Related

vba Is Like with a variable

I am creating a userform with approximately 75 text boxes. I would like to create a common function to test the validity of the data for all text boxes by passing the allowable characters to the function along with the string I wish to validate.
For some boxes, I want to check only for numerics (like a phone number with (), -, and spaces stripped prior to calling the function).
For boxes such as last name, I want to test for upper and lower case alpha as well as allowing embedded spaces and a hyphen.
For other boxes that allow other free form text, I want to restrict input to selected character such as letters, numbers, hyphens, left and right parens "()", etc.
I cannot get the syntax right so that the "Is...Like" works correctly. I get "Run time error 5"..."Invalid procedure call or argument".
Here is my function:
Function IsValidString(strValue As String, strAllowed As String) As Boolean
Dim intPos As Integer
Dim strTemp As String
strTemp = """" & strAllowed & """"
MsgBox "StrValue = " & strValue & vbCrLf & vbCrLf & "StrAllowed = " & strAllowed & vbCrLf & vbCrLf & "strTemp = " & strTemp
For intPos = 1 To Len(strValue)
If Not (Mid(strValue, i, 1) Like strAllowed) Then IsValidString = False
Next intPos
IsValidString = True
End Function
To call the function, I use:
If Not IsValidString(strTemp, "[A-Za-z0-9]/#-") Then MsgBox "You Lose"
The error occurs within the Function code. It does not matter if I test for strAllowed or strTemp; I get the same error.
Thanks for looking at it.
Based upon the answer from #Comintern, I overlooked that I was checking the value of "i" instead of "intPos". Stupid mistake from a guy who is tired. Thanks for all the comments; it helped me solve the issue.

UDF - Identify if it's a recalculation or first execution

I want to program a UDF to query a access db. I'm wondering if it's possible to have 2 different Workflows, depending whether it's a first execution or only a recalculation of the UDF.
Ideally I would have a UDF that you can feed the primary key of the db and the UDF presents an overview of possible values of the access db table. If it's a recalculation I don't want to have a userform popup again. Is this possible at all? Can somebody point me in the right direction?
Thx!
Edit
An attempt to show some (dummy) code:
public function key_from_table(primarykey as string) as string
' Read-out column names from Access table for userform
' Trigger userform with possible column names and let user choose
' readout Chosen column names
key_from_table = Call get_from_db(Primary_key, column_names)
end function
Function get_from_db(Primarykey as string, column_names as string) as string
'call Access db and readout result
end Function
If a recalculation is triggered the userform popup comes up again
I'm still new to Excel vba - pls tell me if this is rather stupid :)
Declares a global dictionary variable. Just before you trigger the form, check if dictionary already has the column name. If it does, don't trigger the form. If it doesn't, trigger the form and add the column name to dictionary once form is closed. You can clear the variable in Workbook_BeforeClose just to be clean
Something like this should work for you:
Public pub_sRecalcCheck As String
Public Function MyTest() As Boolean
Dim bReCalc As Boolean
If InStr(1, " " & pub_sRecalcCheck & " ", " " & Application.Caller.Address(External:=True) & " ", vbTextCompare) = 0 Then
'This is a brand new calculation
'Add this cell to the public variable storing where calculations for this UDF have occurred
bReCalc = False
pub_sRecalcCheck = WorksheetFunction.Trim(Replace(pub_sRecalcCheck, " " & rCell.Address(External:=True) & " ", " "))
''''''''''''''''''''''''''''''''''''''''''''
' '
' Your code here for new calculation '
' '
''''''''''''''''''''''''''''''''''''''''''''
Else
'This is a recalculation
bReCalc = True
''''''''''''''''''''''''''''''''''''''''''
' '
' Your code here for recalcuations '
' '
''''''''''''''''''''''''''''''''''''''''''
End If
MyTest = bReCalc
End Function
EDIT: And just in case the formula gets deleted from the cell, use this in the ThisWorkbook module to clear that cell's address from the RecalcCheck public string variable so that if a new formula is put there it is treated as a new calculation:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rCell As Range
For Each rCell In Target.Cells
'Check if cell has been deleted/cleared
If IsEmpty(rCell) Then
'Found deleted cell, check if it is stored for the recalc checks
If InStr(1, " " & pub_sRecalcCheck & " ", " " & rCell.Address(External:=True) & " ", vbTextCompare) > 0 Then
'It is stored, remove it so that if formula is put back it is treated as a new calculation
pub_sRecalcCheck = WorksheetFunction.Trim(Replace(pub_sRecalcCheck, " " & rCell.Address(External:=True) & " ", " "))
End If
End If
Next rCell
End Sub

Excel macro to search for text then Popup box if found then display number of times word appears

Can someone help me alter this code so that when it finds the word it will also display the number of times the word appears? Thanks!
Sub findtext()
'
' findrobot Macro
' Will find the word robot
'
' Keyboard Shortcut: Ctrl+t
'
Dim found As Variant
Set found = Sheets("Email").Cells.find("robot", Sheets("Email").Cells(1, 1), xlValues, xlPart)
If (Not found Is Nothing) Then
'found
MsgBox "Words Found =" & found, vbOKOnly, "Found"
Else
'not found
MsgBox "Sorry the text was not found please try again. Macro stopping"
End If
End Sub
Just for fun (and not really stress tested, but seems to work), here is a non-looping version:
Sub test()
Dim Number As Long
Dim str As String
str = "robot"
Number = Evaluate("=SUMPRODUCT(--(NOT(ISERROR(FIND(""" & str & """,A1:AZ6,1)))))")
MsgBox str & " was found " & Number & " times!"
End Sub
Be sure to adjust the range in the Evaluate line (currently A1:AZ6) to suit your situation. Also, I'm pretty sure this will not return the correct results if the word you're looking for appears multiple times in a cell. I've got to run to a meeting, but if you think that will be the case, I can see if I can sort that out a bit later...

Generate Word Documents (in Excel VBA) from a series of Document Templates

Hey all. I'll try to make this brief and simple. :)
I have
40 or so boilerplate word documents with a series of fields (Name, address, etc) that need to be filled in. This is historically done manually, but it's repetitive and cumbersome.
A workbook where a user has filled a huge set of information about an individual.
I need
A way to programatically (from Excel VBA) open up these boilerplate documents, edit in the value of fields from various named ranges in the workbook, and save the filled in templates to a local folder.
If I were using VBA to programatically edit particular values in a set of spreadsheets, I would edit all those spreadsheets to contain a set of named ranges which could be used during the auto-fill process, but I'm not aware of any 'named field' feature in a Word document.
How could I edit the documents, and create a VBA routine, so that I can open each document, look for a set of fields which might need to be filled in, and substitute a value?
For instance, something that works like:
for each document in set_of_templates
if document.FieldExists("Name") then document.Field("Name").value = strName
if document.FieldExists("Address") then document.Field("Name").value = strAddress
...
document.saveAs( thisWorkbook.Path & "\GeneratedDocs\ " & document.Name )
next document
Things I've considered:
Mail merge - but this is insufficient because it requires opening each document manually and structuring the workbook as a data source, I kind of want the opposite. The templates are the data source and the workbook is iterating through them. Also, mail merge is for creating many identical documents using a table of different data. I have many documents all using the same data.
Using placeholder text such as "#NAME#" and opening each document for a search and replace. This is the solution I would resort to if nothing more elegant is proposed.
It's been a long time since I asked this question, and my solution has undergone more and more refinement. I've had to deal with all sorts of special cases, such as values that come directly from the workbook, sections that need to be specially generated based on lists, and the need to do replacements in headers and footers.
As it turns out, it did not suffice to use bookmarks, as it was possible for users to later edit documents to change, add, and remove placeholder values from the documents. The solution was in fact to use keywords such as this:
This is just a page from a sample document which uses some of the possible values that can get automatically inserted into a document. Over 50 documents exist with completely different structures and layouts, and using different parameters. The only common knowledge shared by the word documents and the excel spreadsheet is a knowledge of what these placeholder values are meant to represent. In excel, this is stored in a list of document generation keywords, which contain the keyword, followed by a reference to the range that actually contains this value:
These were the key two ingredients required. Now with some clever code, all I had to do was iterate over each document to be generated, and then iterate over the range of all known keywords, and do a search and replace for each keyword in each document.
First, I have the wrapper method, which takes care of maintaining an instance of microsoft word iterating over all documents selected for generation, numbering the documents, and doing the user interface stuff (like handling errors, displaying the folder to the user, etc.)
' Purpose: Iterates over and generates all documents in the list of forms to generate
' Improves speed by creating a persistant Word application used for all generated documents
Public Sub GeneratePolicy()
Dim oWrd As New Word.Application
Dim srcPath As String
Dim cel As Range
If ERROR_HANDLING Then On Error GoTo errmsg
If Forms.Cells(2, FormsToGenerateCol) = vbNullString Then _
Err.Raise 1, , "There are no forms selected for document generation."
'Get the path of the document repository where the forms will be found.
srcPath = FindConstant("Document Repository")
'Each form generated will be numbered sequentially by calling a static counter function. This resets it.
GetNextEndorsementNumber reset:=True
'Iterate over each form, calling a function to replace the keywords and save a copy to the output folder
For Each cel In Forms.Range(Forms.Cells(2, FormsToGenerateCol), Forms.Cells(1, FormsToGenerateCol).End(xlDown))
RunReplacements cel.value, CreateDocGenPath(cel.Offset(0, 1).value), oWrd
Next cel
oWrd.Quit
On Error Resume Next
'Display the folder containing the generated documents
Call Shell("explorer.exe " & CreateDocGenPath, vbNormalFocus)
oWrd.Quit False
Application.StatusBar = False
If MsgBox("Policy generation complete. The reserving information will now be recorded.", vbOKCancel, _
"Policy Generated. OK to store reserving info?") = vbOK Then Push_Reserving_Requirements
Exit Sub
errmsg:
MsgBox Err.Description, , "Error generating Policy Documents"
End Sub
That routine calls RunReplacements which takes care of opening the document, prepping the environment for a fast replacement, updating links once done, handling errors, etc:
' Purpose: Opens up a document and replaces all instances of special keywords with their respective values.
' Creates an instance of Word if an existing one is not passed as a parameter.
' Saves a document to the target path once the template has been filled in.
'
' Replacements are done using two helper functions, one for doing simple keyword replacements,
' and one for the more complex replacements like conditional statements and schedules.
Private Sub RunReplacements(ByVal DocumentPath As String, ByVal SaveAsPath As String, _
Optional ByRef oWrd As Word.Application = Nothing)
Dim oDoc As Word.Document
Dim oWrdGiven As Boolean
If oWrd Is Nothing Then Set oWrd = New Word.Application Else oWrdGiven = True
If ERROR_HANDLING Then On Error GoTo docGenError
oWrd.Visible = False
oWrd.DisplayAlerts = wdAlertsNone
Application.StatusBar = "Opening " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1)
Set oDoc = oWrd.Documents.Open(Filename:=DocumentPath, Visible:=False)
RunAdvancedReplacements oDoc
RunSimpleReplacements oDoc
UpdateLinks oDoc 'Routine which will update calculated statements in Word (like current date)
Application.StatusBar = "Saving " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1)
oDoc.SaveAs SaveAsPath
GoTo Finally
docGenError:
MsgBox "Un unknown error occurred while generating document: " & DocumentPath & vbNewLine _
& vbNewLine & Err.Description, vbCritical, "Document Generation"
Finally:
If Not oDoc Is Nothing Then oDoc.Close False: Set oDoc = Nothing
If Not oWrdGiven Then oWrd.Quit False
End Sub
That routine then invokes RunSimpleReplacements. and RunAdvancedReplacements. In the former, we iterate over the set of Document Generation Keywords and call WordDocReplace if the document contains our keyword. Note that it's much faster to try and Find a bunch of words to figure out that they don't exist, then to call replace indiscriminately, so we always check if a keyword exists before attempting to replace it.
' Purpose: While short, this short module does most of the work with the help of the generation keywords
' range on the lists sheet. It loops through every simple keyword that might appear in a document
' and calls a function to have it replaced with the corresponding data from pricing.
Private Sub RunSimpleReplacements(ByRef oDoc As Word.Document)
Dim DocGenKeys As Range, valueSrc As Range
Dim value As String
Dim i As Integer
Set DocGenKeys = Lists.Range("DocumentGenerationKeywords")
For i = 1 To DocGenKeys.Rows.Count
If WordDocContains(oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#") Then
'Find the text that we will be replacing the placeholder keyword with
Set valueSrc = Range(Mid(DocGenKeys.Cells(i, 2).Formula, 2))
If valueSrc.MergeCells Then value = valueSrc.MergeArea.Cells(1, 1).Text Else value = valueSrc.Text
'Perform the replacement
WordDocReplace oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#", value
End If
Next i
End Sub
This is the function used to detect whether a keyword exists in the document:
' Purpose: Function called for each replacement to first determine as quickly as possible whether
' the document contains the keyword, and thus whether replacement actions must be taken.
Public Function WordDocContains(ByRef oDoc As Word.Document, ByVal searchFor As String) As Boolean
Application.StatusBar = "Checking for keyword: " & searchFor
WordDocContains = False
Dim storyRange As Word.Range
For Each storyRange In oDoc.StoryRanges
With storyRange.Find
.Text = searchFor
WordDocContains = WordDocContains Or .Execute
End With
If WordDocContains Then Exit For
Next
End Function
And this is where the rubber meets the road - the code that executes the replacement. This routine got more complicated as I encountered difficulties. Here are the lessons you will only learn from experience:
You can set the replacement text directly, or you can use the clipboard. I found out the hard way that if you are doing a VBA replace in word using a string longer than 255 characters, the text will get truncated if you try to place it in the Find.Replacement.Text, but you can use "^c" as your replacement text, and it will get it directly from the clipboard. This was the workaround I got to use.
Simply calling replace will miss keywords in some text areas like headers and footers. Because of this, you actually need to iterate over the document.StoryRanges and run the search and replace on each one to ensure that you catch all instances of the word you want to replace.
If you're setting the Replacement.Text directly, you need to convert Excel line breaks (vbNewLine and Chr(10)) with a simple vbCr for them to appear properly in word. Otherwise, anywhere your replacement text has line breaks coming from an excel cell will end up inserting strange symbols into word. If you use the clipboard method however, you do not need to do this, as the line breaks get converted automatically when put in the clipboard.
That explains everything. Comments should be pretty clear too. Here's the golden routine that executes the magic:
' Purpose: This function actually performs replacements using the Microsoft Word API
Public Sub WordDocReplace(ByRef oDoc As Word.Document, ByVal replaceMe As String, ByVal replaceWith As String)
Dim clipBoard As New MSForms.DataObject
Dim storyRange As Word.Range
Dim tooLong As Boolean
Application.StatusBar = "Replacing instances of keyword: " & replaceMe
'We want to use regular search and replace if we can. It's faster and preserves the formatting that
'the keyword being replaced held (like bold). If the string is longer than 255 chars though, the
'standard replace method doesn't work, and so we must use the clipboard method (^c special character),
'which does not preserve formatting. This is alright for schedules though, which are always plain text.
If Len(replaceWith) > 255 Then tooLong = True
If tooLong Then
clipBoard.SetText IIf(replaceWith = vbNullString, "", replaceWith)
clipBoard.PutInClipboard
Else
'Convert excel in-cell line breaks to word line breaks. (Not necessary if using clipboard)
replaceWith = Replace(replaceWith, vbNewLine, vbCr)
replaceWith = Replace(replaceWith, Chr(10), vbCr)
End If
'Replacement must be done on multiple 'StoryRanges'. Unfortunately, simply calling replace will miss
'keywords in some text areas like headers and footers.
For Each storyRange In oDoc.StoryRanges
Do
With storyRange.Find
.MatchWildcards = True
.Text = replaceMe
.Replacement.Text = IIf(tooLong, "^c", replaceWith)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
On Error Resume Next
Set storyRange = storyRange.NextStoryRange
On Error GoTo 0
Loop While Not storyRange Is Nothing
Next
If tooLong Then clipBoard.SetText ""
If tooLong Then clipBoard.PutInClipboard
End Sub
When the dust settles, we're left with a beautiful version of the initial document with production values in place of those hash marked keywords. I'd love to show an example, but of course every filled in document contain all-proprietary information.
The only think left to mention I guess would be that RunAdvancedReplacements section. It does something extremely similar - it ends up calling the same WordDocReplace function, but what's special about the keywords used here is that they don't link to a single cell in the original workbook, they get generated in the code-behind from lists in the workbook. So for instance, one of the advanced replacements would look like this:
'Generate the schedule of vessels
If WordDocContains(oDoc, "#VESSELSCHEDULE#") Then _
WordDocReplace oDoc, "#VESSELSCHEDULE#", GenerateVesselSchedule()
And then there will be a corresponding routine which puts together a string containing all the vessel information as configured by the user:
' Purpose: Generates the list of vessels from the "Vessels" sheet based on the user's configuration
' in the booking tab. The user has the option to generate one or both of Owned Vessels
' and Chartered Vessels, as well as what fields to display. Uses a helper function.
Public Function GenerateVesselSchedule() As String
Dim value As String
Application.StatusBar = "Generating Schedule of Vessels."
If Booking.Range("ListVessels").value = "Yes" Then
Dim VesselCount As Long
If Booking.Range("ListVessels").Offset(1).value = "Yes" Then _
value = value & GenerateVesselScheduleHelper("Vessels", VesselCount)
If Booking.Range("ListVessels").Offset(1).value = "Yes" And _
Booking.Range("ListVessels").Offset(2).value = "Yes" Then _
value = value & "(Chartered Vessels)" & vbNewLine
If Booking.Range("ListVessels").Offset(2).value = "Yes" Then _
value = value & GenerateVesselScheduleHelper("CharteredVessels", VesselCount)
If Len(value) > 2 Then value = Left(value, Len(value) - 2) 'Remove the trailing line break
Else
GenerateVesselSchedule = Booking.Range("VesselSchedAlternateText").Text
End If
GenerateVesselSchedule = value
End Function
' Purpose: Helper function for the Vessel Schedule generation routine. Generates either the Owned or
' Chartered vessels based on the schedule parameter passed. The list is numbered and contains
' the information selected by the user on the Booking sheet.
' SENSITIVE: Note that this routine is sensitive to the layout of the Vessel Schedule tab and the
' parameters on the Configure Quotes tab. If either changes, it should be revisited.
Public Function GenerateVesselScheduleHelper(ByVal schedule As String, ByRef VesselCount As Long) As String
Dim value As String, nextline As String
Dim numInfo As Long, iRow As Long, iCol As Long
Dim Inclusions() As Boolean, Columns() As Long
'Gather info about vessel info to display in the schedule
With Booking.Range("VesselInfoToInclude")
numInfo = Booking.Range(.Cells(1, 1), .End(xlToRight)).Columns.Count - 1
ReDim Inclusions(1 To numInfo)
ReDim Columns(1 To numInfo)
On Error Resume Next 'Some columns won't be identified
For iCol = 1 To numInfo
Inclusions(iCol) = .Offset(0, iCol) = "Yes"
Columns(iCol) = sumSchedVessels.Range(schedule).Cells(1).EntireRow.Find(.Offset(-1, iCol)).Column
Next iCol
On Error GoTo 0
End With
'Build the schedule
With sumSchedVessels.Range(schedule)
For iRow = .row + 1 To .row + .Rows.Count - 1
If Len(sumSchedVessels.Cells(iRow, Columns(1)).value) > 0 Then
VesselCount = VesselCount + 1
value = value & VesselCount & "." & vbTab
nextline = vbNullString
'Add each property that was included to the description string
If Inclusions(1) Then nextline = nextline & sumSchedVessels.Cells(iRow, Columns(1)) & vbTab
If Inclusions(2) Then nextline = nextline & "Built: " & sumSchedVessels.Cells(iRow, Columns(2)) & vbTab
If Inclusions(3) Then nextline = nextline & "Length: " & _
Format(sumSchedVessels.Cells(iRow, Columns(3)), "#'") & vbTab
If Inclusions(4) Then nextline = nextline & "" & sumSchedVessels.Cells(iRow, Columns(4)) & vbTab
If Inclusions(5) Then nextline = nextline & "Hull Value: " & _
Format(sumSchedVessels.Cells(iRow, Columns(5)), "$#,##0") & vbTab
If Inclusions(6) Then nextline = nextline & "IV: " & _
Format(sumSchedVessels.Cells(iRow, Columns(6)), "$#,##0") & vbTab
If Inclusions(7) Then nextline = nextline & "TIV: " & _
Format(sumSchedVessels.Cells(iRow, Columns(7)), "$#,##0") & vbTab
If Inclusions(8) And schedule = "CharteredVessels" Then _
nextline = nextline & "Deductible: " & Format(bmCharterers.Range(schedule).Cells( _
iRow - .row, 9), "$#,##0") & vbTab
nextline = Left(nextline, Len(nextline) - 1) 'Remove the trailing tab
'If more than 4 properties were included insert a new line after the 4th one
Dim tabloc As Long: tabloc = 0
Dim counter As Long: counter = 0
Do
tabloc = tabloc + 1
tabloc = InStr(tabloc, nextline, vbTab)
If tabloc > 0 Then counter = counter + 1
Loop While tabloc > 0 And counter < 4
If counter = 4 Then nextline = Left(nextline, tabloc - 1) & vbNewLine & Mid(nextline, tabloc)
value = value & nextline & vbNewLine
End If
Next iRow
End With
GenerateVesselScheduleHelper = value
End Function
the resulting string can be used just like the contents of any excel cell, and passed to the replacement function, which will appropriately use the clipboard method if it exceeds 255 characters.
So this template:
Plus this spreadsheet data:
Becomes this document:
I sincerely hope that this helps someone out some day. It was definitely a huge undertaking and a complex wheel to have to re-invent. The application is huge, with over 50,000 lines of VBA code, so if I've referenced a crucial method in my code somewhere that someone needs, please leave a comment and I'll add it in here.
http://www.computorcompanion.com/LPMArticle.asp?ID=224 Describes the use of Word bookmarks
A section of text in a document can be bookmarked, and given a variable name. Using VBA, this variable can be accessed and the content in the document can be replaced with alternate content. This is a solution to having placeholders such as Name and Address in the document.
Furthermore, using bookmarks, documents can be modified to reference bookmarked text. If a name appears several times throughout a document, the first instance can be bookmarked, and additional instances can reference the bookmark. Now when the first instance is programatically changed, all other instances of the variable throughout the document are also automatically changed.
Now all that's needed is to update all the documents by bookmarking the placeholder text and using a consistent naming convention throughout the documents, then iterate through each documents replacing the bookmark if it exists:
document.Bookmarks("myBookmark").Range.Text = "Inserted Text"
I can probably solve the problem of variables that don't appear in a given document using the on error resume next clause before attempting each replacement.
Thanks to Doug Glancy for mentioning the existance of bookmarks in his comment. I had no knowledge of their existence beforehand. I will keep this topic posted on whether this solution suffices.
You might consider an XML based approach.
Word has a feature called Custom XML data-binding, or data-bound content controls. A content control is essentially a point in the document which can contain content. A "data-bound" content control gets its content from an XML document you include in the docx zip file. An XPath expression is used to say which bit of XML. So all you need to do is include your XML file, and Word will do the rest.
Excel has ways to get data out of it as XML, so the whole solution should work nicely.
There is plenty of information on content control data-binding on MSDN (some of which has been referenced in earlier SO questions) so I won't bother including them here.
But you do need a way of setting up the bindings. You can either use the Content Control Toolkit, or if you want to do it from within Word, my OpenDoPE add-in.
Having done a similar task I found that inserting values into tables was much quicker than searching for named tags - the data can then be inserted like this:
With oDoc.Tables(5)
For i = 0 To Data.InvoiceDictionary.Count - 1
If i > 0 Then
oDoc.Tables(5).rows.Add
End If
Set invoice = Data.InvoiceDictionary.Items(i)
.Cell(i + 2, 1).Range.Text = invoice.InvoiceCCNumber
.Cell(i + 2, 2).Range.Text = invoice.InvoiceDate
.Cell(i + 2, 3).Range.Text = invoice.TransactionType
.Cell(i + 2, 4).Range.Text = invoice.Description
.Cell(i + 2, 5).Range.Text = invoice.SumOfValue
Next i
.Cell(i + 1, 4).Range.Text = "Total:"
End With
in this case row 1 of the table was the headers; row 2 was empty and there were no further rows - thus the rows.add applies once more than one row was attached. The tables can be very detailed documents and by hiding the borders and cell borders can be made to look like ordinary text. Tables are numbered sequentially following the document flow. (i.e. Doc.Tables(1) is the first table...

Excel Macro to find text in cell and insert hyperlink on cell

We're managing some system bugs in a web system and setting priority for execs in a spreadsheet.
Each of the tickets has a "FD-" and four numbers as the ID.
The web system has a hyperlink that has that "FD-####" at the end of the link.
The end result would look like this -- http://www.mytickets.com/FD-####
I'd like to run a macro that finds all the FD-#### and inserts a hyperlink on each.
There may be multiple FD-#### in a single cell and there will certainly be other text in there.
I'd go through each and add the link but there are over 150 or so.
Thanks!
As mentioned in a comment, Excel doesn't seem to support multiple hyperlinks in a cell.
The code below will do the replacement from ticket to link:
Option Explicit
Sub loop_over_cells()
Dim a_cell
Dim replaced As String
For Each a_cell In ActiveSheet.UsedRange
Debug.Print "old value " & a_cell.Value
replaced = RegexReplace(a_cell.Value, "(fd-\d{4}\b)", "=hyperlink(" & Chr(34) & "http://cnn.com/$1" & Chr(34) & ")")
a_cell.Value = replaced
Debug.Print "new value " & a_cell.Value
Next
End Sub
Function RegexReplace(search_string, ptrn, rplc)
Dim regEx
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = ptrn
regEx.IgnoreCase = True
regEx.Global = True
RegexReplace = regEx.replace(search_string, rplc)
End Function

Resources