ISSUE: How to fix a Word VBA FOR EACH subroutine that seeks to insert a comment at each tracked change and, yet, will freeze VBA/Word at certain pages of a document and not other pages.
The below code works on some documents throughout the entire document. Other documents, unfortunately, will freeze at certain locations in the document.
I've F8 stepped through, for example, to find one document would freeze at pages 6 and 7 of a 22 page document. Strangely, however, I could run the code to insert comments at each tracked pages on all other pages.
Dim rev As Revision, txt As String
Dim pgno1 As String
Dim pgno2 As String
Application.ScreenUpdating = False
ActiveDocument.TrackRevisions = False
'check Revisions
For Each rev In ActiveDocument.Revisions
Select Case rev.Type
Case wdRevisionDelete
txt = Left(rev.Range.Text, 3) 'the deleted text
rev.Range.Comments.Add Range:=rev.Range, Text:="Pg [#" & pgno1 & "] BLAH " & txt & " [ ... ]“
Case wdRevisionInsert
txt = Left(rev.Range.Text, 3) 'the inserted text
rev.Range.Comments.Add Range:=rev.Range, Text:= "Pg [#" & pgno1 & "] BLAH " & txt & " […]”
End Select
Next rev
ActiveDocument.TrackRevisions = True
GOAL: Insert comment with specific text at each tracked change, throughout entire docxz
ERRORS: No messages. VBA and Word freeze, requiring restart.
Related
I have to format a large document for a file that has been created from a PDF which is editable, so I know all the text is there.
The document is a series of tables. In Word the tables look pretty OK, but in some cases where there should be various cells there is just 1 and tabs have been used to align the text. So, it looks good, but if any of the text gets changed then the formatting will get messed up. I would like to have a macro that looks for cells with a tab, selects the cell, counts the number of tabs, divides the cell into the right number of cells and puts the text into the right cell. For example, a cell that contains "text 1 [tab]text 2[tab]text 3" would become 3 cells "text 1", "text 2" and "text 3".
I thought Word would be able to convert the text to a table, but when the text is already in a table it doesn't work.
If anyone has any suggestions as to how I might achieve this, then they would be much appreciated!
My main issue is not knowing how to count how many tabs are in a selection.
This function will return the number of Tabs in the given string.
Function CountTabs() As Integer
Dim Txt As String
Txt = "This is" & vbTab & "a test" & vbTab & "to count Tabs"
CountTabs = Len(Txt) - Len(Replace(Txt, vbTab, ""))
End Function
The tab character - Chr(9) - is replace with nothing and the number of tabs is the difference in character count before and after the replacement. Here is an implementation of the idea in a snippet.
Private Sub Snippet()
Dim Txt As String
Dim Count As Integer
Txt = "This is" & vbTab & "a test" & vbTab & "to count Tabs"
Count = Len(Txt) - Len(Replace(Txt, vbTab, ""))
MsgBox "There are " & Count & " tabs."
End Sub
Of course, how you get the text for the variable Txt is another story and, in the context of this forum, another question. Prophylactically, I advise against using the Selection object, however. Try to use the Range object instead.
I have a big table in ms-word that contains 85 contentcontrols (combo boxes). I want to change the content using a vba loop (see below). It takes longer than one minute for it to complete...
Are there other options?
Private Sub Btn_Clear1_Click()
Dim a
Dim c As ContentControl
a = FindTable(ActiveDocument.Name, "myTableName")(1) 'returns an array(Long) with number of table found
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
End Sub
Thanks in advance for any hint!
Here, turning off screenupdating reduces the time from about 6 seconds to less than 1 second. e.g.
On Error Goto turnscreenon
Application.Screenupdating = False
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
turnscreenon:
Application.Screenupdating = True
That may only work on the Windows version of Word.
If you know exactly how many combo boxes there are going to be, you could consider creating a custom xml part containing an array of XML Elements to contain the values. Map each content control to one of those elements. Then instead of writing the values to the content control ranges, write them to the XML Part and let Word do the work. That works almost instantaneously here.
e.g. in a simple scenario where you just have those 85 content controls in the table, you could set up the Custom XML Part like this (I leave you to write any code that you need to delete old versions). You should only need to run this once.
Sub createCxpAndLink()
' You should choose your own Uri
Const myNamespaceUri As String = "mycbcs"
Dim a
Dim i As Long
Dim s As String
Dim cxp As Office.CustomXMLPart
With ActiveDocument
a = FindTable(.Name, "myTableName")(1)
s = ""
s = s & "<?xml version='1.0' encoding='UTF-8'?>" & vbCrLf
s = s & "<cbcs xmlns='" & myNamespaceUri & "'>" & vbCrLf
For i = 1 To .Tables(a).Range.ContentControls.Count
s = s & " <cbc/>" & vbCrLf
Next
s = s & "</cbcs>"
Set cxp = .CustomXMLParts.Add(s)
With .Tables(a).Range.ContentControls
For i = 1 To .Count
.Item(i).XMLMapping.SetMapping "/x:cbcs[1]/x:cbc[" & Trim(CStr(i)) & "]", "xmlns:x='" & myNamespaceUri & "'", cxp
Next
End With
Set cxp = Nothing
End With
End Sub
Then to update the contents you need something like this
Sub testsetxml()
Const myNamespaceUri As String = "mycbcs"
Dim i As Long
'our start time...
Debug.Print Now
With ActiveDocument.CustomXMLParts.SelectByNamespace(myNamespaceUri)(1)
For i = 1 To 85
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text "
' or if you want to put different texts in different controls, you can test using e.g.
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text " & Cstr(i)
Next
End With
'our end time...
Debug.Print Now
End Sub
(NB you cannot do it by mapping all the controls to a single XML element because then all the dropdowns will all be updated to the same value whenever you change the value of one of them.)
Apologies for any typos - I've changed the code to be more in line with what you have already and have not tested the changes.
I have an excel sheet [Microsoft Office 2010] where the user can select a certain commodity & category, after which a list of suppliers linked to that commodity & category are printed on the sheet. I now want to print out hyperlinks next to this list of suppliers that perform a google search using the supplier as search term. This is the code I got right now: It checks whether the cells in column 6 are empty or not, if not that means a supplier name is printed in the cell. I then want a hyperlink to be printed in the column next to it that links to a google search using the suppliername as search term.
EDIT: code below works. Issue was in the if statement - isEmpty did not work for string value, but vbNullString fixed the issue.
Previous issueL
The printed links lead to the general google home page, with no search terms. I believe the reason why the links are leading to general google pages is because the actual cell values (which are used as search term) are not read properly. The code line "If Not IsEmpty(cellSupplierListed) Then" always runs, even when the cells have no suppliername in there.. I'm not sure why.
Also: Let's say there are 5 suppliers listed and the code reads over 300 rows (hard coded in code above), then still 300 links are printed out, while only 5 should have been printed out. (as only 5 of the 300 rows have values). Those 5 suppliers are printed out by previous code in the same sub and do indeed show up on the excel sheet. It just appears that the code below is not reading blank cells as being blank cells or non-blank cells as non-blank cells.
Dim cellSupplierListed As String
Dim csl As Integer
Dim h As Integer
h = 0
For csl = 1 To 300 'needs to be updated if more than 300 suppliers are listed
cellSupplierListed = Cells(9 + csl, 4).Value
If cellSupplierListed = vbNullString Then
Exit For
Else
h = h + 1
Range("G" & (9 + h)).Hyperlinks.Add Range("G" & (9 + h)), "http://www.google.com/search?q=" & cellSupplierListed, , , "Link"
End If
Next csl
From https://msdn.microsoft.com/en-us/library/office/ff822490.aspx
For Office 2013 and later, you can use the Hyperlinks.Add method
.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)
Example (from the above linked documentation):
With Worksheets(1)
.Hyperlinks.Add Anchor:=.Range("a5"), _
Address:="http://example.microsoft.com", _
ScreenTip:="Microsoft Web Site", _
TextToDisplay:="Microsoft"
End With
The following was tested in Office 2007:
Range("a5").Hyperlinks.Add Range("a5"), "http://www.google.com"
For the OP's actual question:
Change the following line
Cells(7, 9 + h) = Hyperlink("http://www.google.com/search?q=" & cellSupplierListed, "Link")
to
Range("F"&(9+h)).Hyperlinks.Add Range("F"&(9+h)), "http://www.google.com/search?q=" & cellSupplierListed,,,"Link"
You can copy the values and paste them back as html:
[f:f].Copy
Set o = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' New MSForms.DataObject
o.GetFromClipboard: s = o.GetText
Application.CutCopyMode = False
before = "<a href='http://www.google.com/search?q=": after = "'>Link</a><br>"
s = Replace(s, vbNewLine, after & vbNewLine & before)
s = "<html>" & before & s & after
s = Replace(s, before & after, "<br>") ' replace the blank values
o.SetText s: o.PutInClipboard
[g1].PasteSpecial "Text"
I have a template document in Word 2013 that has the user fill in a large number of Legacy Text FormFields. At the end of the document, I've included a button which compiles the answers into a string devoid of formatting, then copies it to the clipboard.
It works, but as each FormField is read, the Word document skips back and forth between each text field and the end of the document. It's visually alarming. Is there a way to gather the values of each FormField without Word moving the cursor/focus to each field as it is read?
Here's a sample of the code:
Private Sub cmdCreateNote_Click()
Call cmdClearNote_Click
Dim ff As FormFields
Set ff = ActiveDocument.FormFields
Dim Output As String
Output = ff("ddReviewType").Result & vbCrLf
If ff("chFacInfo").Result Then
Dim FacInfo
FacInfo = Array("Field1: ", _
"Field2: ", _
"Field3: ", _
"Field4: ", _
"Field5: ")
Output = Output & "FIRST SECTION" & vbCrLf
For Index = 1 To 5
If ff("chFacInfo" & Index).Result Then
Output = Output & FacInfo(Index - 1) & ff("txFacInfo" & Index).Result & vbCrLf
End If
Next
Output = Output & vbCrLf
End If
Dim FORange As Range
Set FORange = ActiveDocument.Bookmarks("FinalOutput").Range
FORange.Text = Output
ActiveDocument.Bookmarks.Add "FinalOutput", FORange
Selection.GoTo What:=wdGoToBookmark, Name:="FinalOutput"
Selection.Copy
End Sub
It appears that every time I access ActiveDocument.FormFields( x ).Result, the document focus goes to that element, then drops back to the end of the document again.
Any pointers?
Use the Bookmark object instead of the FormField. This will allow you to access the properties without changing the screen focus. See answer on Suppress unwanted jumping/scrolling on Word 2013 VBA Script for specifics on how to do this.
ActiveDocument.Bookmarks("myFieldName").Range.Fields(1).Result
Posting comment as answer, since it worked!
Try Application.ScreenUpdating = False before going through the FormFields and then setting it to True after, in order to minimize screen updating.
I am particularly new to coding, not to mention VBA. After a week of really cracking down on learning VBA, I've started to get the hang of it. At the moment, I'm trying to put together a code that will pull the hyperlinks (both addresses and names) out of a word document (eventually word, excel, and power point files), and dump them into the excel file I run the code from. It also dumps the file path and name at the top of the list. I can run the code and pull links from 1 file at a time, and the code pops it out after the end of the last filled line. It will save me endless amounts of time when I have to update links.
Sub ExtractWordLinks()
'the following code gets and sets an open file command bar for word documents
Dim Filter, Caption, SelectedFile As String
Dim Finalrow As String
Filter = "docx Files (*.docx),*.docx, doc Files (*.doc),*.doc, xlsm Files (*.xlsx),*.xlsx"
Caption = "Please Select .doc, .docx, .xlsx files only, " & TheUser
SelectedFile = Application.GetOpenFilename(Filter, , Caption)
'check if value is blank if it is exit
Finalrow = Cells(Rows.Count, 1).End(xlUp).Row
If (Trim(SelectedFile) = "") Then
Exit Sub
Else
'setting up the inital word application object
Set wordapp = CreateObject("word.Application")
'opening the document that is defined in the open file dialog
wordapp.documents.Open (SelectedFile)
'ability to change wether it needs to burn cycles updating the UI
wordapp.Visible = False
'declare excel sheet
Dim xlsSheet As Excel.Worksheet
'set active sheet
Set xlsSheet = Application.ActiveSheet
Dim i As Integer
i = 1
'MsgBox (wordapp.ActiveDocument.Hyperlinks.Count)
For i = 1 To wordapp.ActiveDocument.Hyperlinks.Count
'puts the title of the document in the formatted cells
'xlsSheet.Cells(Finalrow + 1, 1).Value = wordapp.ActiveDocument.Path & "\" & wordapp.ActiveDocument.Name
'formats the file name cell to be a bit easier to discern from the listing.
Range(Cells(Finalrow + 1, 1), Cells(Finalrow + 1, 2)).Font.Bold = True
Range(Cells(Finalrow + 1, 1), Cells(Finalrow + 1, 2)).Merge
'save the links address.
xlsSheet.Cells(Finalrow + i, 1).Value = wordapp.ActiveDocument.Hyperlinks(i).Address
'save the links display text
xlsSheet.Cells(Finalrow + i, 2).Value = wordapp.ActiveDocument.Hyperlinks(i).TextToDisplay
Next
wordapp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
wordapp.Quit SaveChanges:=wdDoNotSaveChanges
End If
End Sub
My problem, is that when I run this code on a simple sample file with 3 or so hyperlinks in it across a single page, it returns everything exactly how I want, with the file path/name at the top and all the links in the page directly below it (address in one column, displayed text in the other). However, when I run it on one of the files I am writing this code for (a 95+ page .docx file with ~30 links), it prints out the path/file in the formatted section, and then drops 90 (90 every time) blank lines before printing out the path/file a second time, and then all the links in the document. It does it perfectly, except for the inexplicable second path/file (even there if I comment out the bit I put in) and the 90 blank entries.
Can anyone explain what's going on, or should I try to figure out a way to just bypass the issue by removing my own link code, and including a bit that removes all blank lines?