I'm looking to extract the inserted and deleted text from a word document after it's been reviewed. I've been able to extract the comments using the following macro:
Sub ExportComment()
Dim s As String
Dim cmt As Word.Comment
Dim doc As Word.Document
Dim workBk As Word.Document
Set workBk = ActiveDocument
Set doc = Documents.Add(Visible:=True)
Dim myRange As Range
Set myRange = doc.Range(0, 0)
Dim myTable As Table
Set myTable = doc.Tables.Add(Range:=myRange, NumRows:=workBk.Comments.Count, NumColumns:=6)
Dim i As Integer
i = 1
For Each cmt In workBk.Comments
myTable.Cell(i, 1).Range.Text = cmt.Index
myTable.Cell(i, 2).Range.Text = cmt.Scope.Information(wdActiveEndPageNumber)
myTable.Cell(i, 3).Range.Text = cmt.Initial
myTable.Cell(i, 4).Range.Text = cmt.Scope
myTable.Cell(i, 5).Range.Text = cmt.Range.Text
i = i + 1
Next
End Sub
But can't seem to figure out how to also get the inserted and deleted text from the tracked changes. Any ideas?
Thanks!
Just as you used the Comments collection in your sample code, you will want to use the Revisions Collection (for example, Dim rev as Word.Revision). Unlike Comments, Revisions has a Type property that you can use to identify different varieties of Track Changes. Here are some revision types:
If you want to see example VBA code that extracts revisions, go to
http://www.thedoctools.com/downloads/basTrackChanges_Extract.shtml
which is referenced on the below page while discussing the issue of extracting revisions:
http://www.thedoctools.com/index.php?show=mt_trackchanges_extract
Related
Considering the example for search & replace of specific uk-to-us words from the Editing Text Documents OO Wiki:
Dim I As Long
Dim Doc As Object
Dim Replace As Object
Dim BritishWords(5) As String
Dim USWords(5) As String
BritishWords() = Array("colour", "neighbour", "centre", "behaviour", _
"metre", "through")
USWords() = Array("color", "neighbor", "center", "behavior", _
"meter", "thru")
Doc = ThisComponent
Replace = Doc.createReplaceDescriptor
For I = 0 To 5
Replace.SearchString = BritishWords(I)
Replace.ReplaceString = USWords(I)
Doc.replaceAll(Replace)
Next I
Question: is there a way to get the count of actual replacement that has been made ? (if any) I don't mind the individual count for each term, but just globally – i.e. if, say, the original text included 2 occurences for 'colour' and 1 for 'behaviour', in the end to get the number 3 (purpose: to report this number to user as info via MsgBox).
As shown in the example at https://www.openoffice.org/api/docs/common/ref/com/sun/star/util/XReplaceable.html, the number found is returned.
Dim TotalFound As Long
TotalFound = 0
...
TotalFound = TotalFound + Doc.replaceAll(Replace)
Next I
MsgBox "Replaced " & TotalFound & " occurrences"
Result: Replaced 3 occurrences
I am using draw to mark up a pdf format index map. So in grid 99, the text hyperlinks to map99.pdf
There are 1000's of grid cells - is there a way for a (macro) to scan for text in a sheet that is like
Text in File | Link to add
99|file:///c:/maps/map99.pdf
100|file:///c:/maps/map100.pdf
and add links to the relevant file whenever the text is found (99,100 etc).
I don't use libre much but happy to implement any programatic solution.
Ok, after using xray to drill through enumerated content, I finally have the answer. The code needs to create a text field using a cursor. Here is a complete working solution:
Sub AddLinks
Dim oDocument As Object
Dim vDescriptor, vFound
Dim numText As String, tryNumText As Integer
Dim oDrawPages, oDrawPage
Dim oField, oCurs
Dim numChanged As Integer
oDocument = ThisComponent
oDrawPages = oDocument.getDrawPages()
oDrawPage = oDrawPages.getByIndex(0)
numChanged = 0
For tryNumText = 1 to 1000
vDescriptor = oDrawPage.createSearchDescriptor
With vDescriptor
'.SearchString = "[:digit:]+" 'Patterns work in search box but not here?
.SearchString = tryNumText
End With
vFound = oDrawPage.findFirst(vDescriptor)
If Not IsNull(vFound) Then
numText = vFound.getString()
oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")
oField.Representation = numText
oField.URL = numText & ".pdf"
vFound.setString("")
oCurs = vFound.getText().createTextCursorByRange(vFound)
oCurs.getText().insertTextContent(oCurs, oField, False)
numChanged = numChanged + 1
End If
Next tryNumText
MsgBox("Added " & numChanged & " links.")
End Sub
To save relative links, go to File -> Export as PDF -> Links and check Export URLs relative to file system.
I uploaded an example file here that works. For some reason your example file is hanging on my system -- maybe it's too large.
Replacing text with links is much easier in Writer than in Draw. However Writer does not open PDF files.
There is some related code at https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=1401.
I've created a form within Access which uses a cross-tab query as its data source.
The column headings for the query are 1, 2, 3, 4 and 5 representing week numbers.
The values display items such as 3/3 = 100.00% or 0/13 = 0.00% or 3/14 = 21.00%.
I've added conditional formatting to the text boxes on the form.
Expression Is Right([2],7)="100.00%" works and displays the figure in bold red when the percentage is 100.
Expression is Val(Right([2],7))=100 also works - converting the text value to a numeric value.
The problem I'm having is that I'm not always looking for 100% - it depends on the value within a table. What I'm trying to do is
Val(Right([2],7))=(SELECT ParamValue*100 FROM tbl_System WHERE Param='SampleSize') - this doesn't work.
Neither does:
Eval(Val(Right([2],7))=(SELECT ParamValue*100 FROM tbl_System WHERE Param='SampleSize'))
or
Val(Right([2],7))=EVAL(SELECT ParamValue*100 FROM tbl_System WHERE Param='SampleSize')
or
Val(Right([2],7))=DLookUp("ParamValue","tbl_System","Param= 'SampleSize'")*100
or
Val(Right([2],7))=Eval(DLookUp("ParamValue","tbl_System","Param= 'SampleSize'")*100)
The SQL for the cross-tab query is:
TRANSFORM NZ(Sum(Abs([Include])),0) & "/" & NZ(Count(*),0) & " = " &
FormatPercent(NZ(Round(Sum(Abs(Include))/Count(*),2),0),2)
SELECT tbl_TMP_PrimaryDataSelection.TeamMember
FROM tbl_TMP_PrimaryDataSelection
GROUP BY tbl_TMP_PrimaryDataSelection.TeamMember
PIVOT tbl_TMP_PrimaryDataSelection.WeekNum In (1,2,3,4,5)
I don't think you can use a function in there, be it system or user-defined.
But you can define the FormatCondition dynamically at runtime, like this:
Dim txtFld As TextBox
Dim objFrc As FormatCondition
Dim strExpr As String
Set txtFld = Me!myTextBox
' Remove existing FormatConditions
txtFld.FormatConditions.Delete
' The dynamic expression
strExpr = "Val(Right([2],7))=" & DLookUp("ParamValue","tbl_System","Param='SampleSize'")*100
' Assign a new FormatCondition to text box
Set objFrc = txtFld.FormatConditions.Add(acExpression, , strExpr)
' Set the format
objFrc.ForeColor = &HFF0000
This example simply removes and recreates all FormatConditions. If you have a fixed number of conditions, you can also use the FormatCondition.Modify method (see online help).
Edit:
The final code I have used executes on the Form_Load event and adds a format to each of the five weekly text boxes:
Private Sub Form_Load()
Dim aTxtBox(1 To 5) As TextBox
Dim x As Long
Dim oFrc As FormatCondition
Dim sExpr As String
With Me
Set aTxtBox(1) = .Wk1
Set aTxtBox(2) = .Wk2
Set aTxtBox(3) = .Wk3
Set aTxtBox(4) = .Wk4
Set aTxtBox(5) = .Wk5
For x = 1 To 5
aTxtBox(x).FormatConditions.Delete
sExpr = "Val(Right([" & x & "],7))>=" & DLookup("ParamValue", "tbl_System", "Param='SampleSize'") * 100
Set oFrc = aTxtBox(x).FormatConditions.Add(acExpression, , sExpr)
oFrc.ForeColor = RGB(255, 0, 0)
Next x
End With
End Sub
Edit 2
Yes, defining FormatConditions via VBA is especially useful when dealing with multiple controls in a loop. You can do this in Design View too and save the FormatConditions permanently, simply to avoid going through the FormatConditions dialogs one by one. Or if the customer later decides that he'd rather have a different color. :)
Note: You could use Set aTxtBox(x) = Me("Wk" & x) in the loop. But actually you don't need multiple TextBox variables, you can simply re-use it.
On OpenOffice documentation [1], I found a replace example. But I didn't find a search example.
Dim Doc As Object
Dim Sheet As Object
Dim ReplaceDescriptor As Object
Dim I As Integer
Doc = ThisComponent
Sheet = Doc.Sheets(0)
ReplaceDescriptor = Sheet.createReplaceDescriptor()
ReplaceDescriptor.SearchString = "is"
ReplaceDescriptor.ReplaceString = "was"
For I = 0 to Doc.Sheets.Count - 1
Sheet = Doc.Sheets(I)
Sheet.ReplaceAll(ReplaceDescriptor)
Next I
And better: Where can I find the docs that list the range/cell possible methods?
[1] http://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Editing_Spreadsheet_Documents
first of all: https://wiki.openoffice.org/wiki/Extensions_development_basic is a good starting point. In particular the XRAY tool is very helpfully.
The following code shows a search example:
Dim oDoc As Object
Dim oSheet As Object
Dim oSearchDescriptor As Object
Dim i As Integer
oDoc = ThisComponent
oSheet = oDoc.Sheets(0)
oSearchDescriptor = oSheet.createSearchDescriptor()
oSearchDescriptor.SearchString = "is"
For i = 0 to oDoc.Sheets.Count - 1
oSheet = oDoc.Sheets(i)
oResults = oSheet.findAll(oSearchDescriptor)
'xray oResults
if not isnull(oResults) then msgbox oResults.AbsoluteName
Next i
If you have XRAY installed, you can inspect every object with it and you have access to the related API docs.
Greetings
Axel
I'm trying to use a For loop to loop through the fields in a single record recordset to populate the fields on a form. I was hoping to find a way that is neater/reusable than typing out half a dozen lines of txtField.value = rs!Field.
When I look at the code during runtime both variables have the correct information in them, it just isn't displaying them on the form. Any help would be greatly appreciated.
Dim strClient As String
Dim rsClient As dao.Recordset
Dim tfield As String
Dim ffiend As String
Dim fld As dao.Field
Set dbs_Current = CurrentDb()
strClient = "Select * from tblClient where pk_client_id = " & gbl_Client_ID
Set rsClient = dbs_Current.OpenRecordset(strClient)
For Each fld In rsClient.Fields
On Error Resume Next
tfield = "txt" & fld.Name & ".value"
ffield = "rsClient!" & fld.Name
tfield = ffield
Next fld