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
Related
I need to find and delete every occurrence of the following pattern in a Word 2010 document:
RPDIS→ text {INCLUDEPICTURE c:\xxx\xxx.png" \*MERGEFORMAT} text ←RPDIS
Where:
RPDIS→ and ←RPDIS are start and end delimiters
Between the start and end delimiters there can be just text or text and fields with variable content
The * wildcard in the Word Find and Replace dialog box will find the pattern if it contains text only but it will ignore patterns where text is combined with fields. And ^19 will find the field but not the rest of the pattern until the end delimiter.
Can anyone help, please?
Here's a VBA solution. It wildcard searches for RPDIS→*←RPDIS. If the found text contains ^19 (assuming field codes visible; if objects are visible instead of field codes, then the appropriate test is text contains ^01), the found text is deleted. Note that this DOES NOT care about the type of embedded field --- it will delete ANY AND ALL embedded fields that occur between RPDIS→ and ←RPDIS, so use at your own risk. Also, the code has ChrW(8594) and ChrW(8592) to match right-arrow and left-arrow respectively. You may need to change that if your arrows are encoded differently.
Sub test()
Dim wdDoc As Word.Document
Dim r As Word.Range
Dim s As String
' Const c As Integer = 19 ' Works when field codes are visible
Const c As Integer = 1 ' Works when objects are visible
Set wdDoc = ActiveDocument
Set r = wdDoc.Content
With r.Find
.Text = "RPDIS" & ChrW(8594) & "*" & ChrW(8592) & "RPDIS"
.MatchWildcards = True
While .Execute
s = r.Text
If InStr(1, s, chr(c), vbTextCompare) > 0 Then
Debug.Print "Delete: " & s
' r.Delete ' This line commented out for testing; remove comments to actively delete
Else
Debug.Print "Keep: " & s
End If
Wend
End With
End Sub
Hope that helps.
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.
Have not been able to find anything that fits my needs.
I have two columns of values (L and U). Column L contains a file names that includes a date in MM-DD-YYYY format (example yadayadayada thru (03-15-2015).pdf) column U contains a date. What I need to do is have a macro compare the date within the file name to the date in the column U. Other dates may appear within the text in column L but the date I need to compare against is always after "thru" and in parentheses followed by the file extension. If they do not match, I need the value in column U highlighted and replaced with the text "FAIL". I'm going to continue searching but any help is greatly appreciated. Thanks!
Does it have to be VBA? This can be accomplished with Conditional Formatting.
Apply this conditional format formula to column U:
=AND(U1<>"",L1<>"",U1<>--TRIM(MID(SUBSTITUTE(TRIM(RIGHT(SUBSTITUTE(L1," ",REPT(" ",255)),255)),")",REPT(" ",255)),2,255)))
And set the number format to Custom "FAIL" with yellow (or the highlight color of your choice) fill.
EDIT
If it has to be VBA, then this should work for you:
Sub tgr()
Const HeaderRow As Long = 1 'Change to your actual header row
Dim ws As Worksheet
Dim rngFail As Range
Dim rngFiles As Range
Dim FileCell As Range
Dim dDate As Double
Set ws = ActiveWorkbook.ActiveSheet
Set rngFiles = ws.Range("L" & HeaderRow + 1, ws.Cells(Rows.Count, "L").End(xlUp))
If rngFiles.Row < HeaderRow + 1 Then Exit Sub 'No data
For Each FileCell In rngFiles.Cells
If Len(Trim(FileCell.Text)) > 0 Then
dDate = 0
On Error Resume Next
dDate = CDbl(CDate(Trim(Mid(Replace(Trim(Right(Replace(FileCell.Text, " ", String(255, " ")), 255)), ")", String(255, " ")), 2, 255))))
On Error GoTo 0
If dDate <> ws.Cells(FileCell.Row, "U").Value2 Then
Select Case (rngFail Is Nothing)
Case True: Set rngFail = ws.Cells(FileCell.Row, "U")
Case Else: Set rngFail = Union(rngFail, ws.Cells(FileCell.Row, "U"))
End Select
End If
End If
Next FileCell
If Not rngFail Is Nothing Then
rngFail.Value = "FAIL"
rngFail.Interior.ColorIndex = 6
End If
End Sub
I would like to replace the text below with only http://www.someurl.com. I have Word mac 2011. To clarify, I do not actually want to return from the field code to the actual hyperlink (blue), I only want the address as text in the document.
{ HYPERLINK "http://www.someurl.com" }
Something like this (but notice it won't deal with nested fields), and unless you change Word preferences, Word will re-insert the links when you start editing the results:
Sub replaceHLs()
Dim hl As Word.Hyperlink
Dim i As Integer
Dim r As Word.Range
Dim strLinkText As String
For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
With ActiveDocument.Hyperlinks(i)
Set r = .Range
strLinkText = .Address
' optional, should be OK for HTML links
If .SubAddress <> "" Then
strLinkText = strLinkText & "#" & .SubAddress
End If
r.Text = strLinkText
r.Font.Color = wdColorBlue
r.Font.Underline = wdUnderlineSingle
Set r = Nothing
End With
Next
End Sub
The autofilter is sorting data vertically, but I want to filter rows horizontally.
Lets say that I have the following table:
1 2 2 1 2
B A E F F
B D E F F
C D E F F
What I can do is to set an autofilter and filter only the rows containing "B" in the first column. What I would like to do is to filter only the rows that contain "2" (in this case the rows are second, third and the last in this case).
I have found some information regarding this matter. All of the answers I found are containing some macros to get the job done, but they were written for MS Excel, and are not compatible with OpenOffice
For example, this macros should get the rows filtered, but is not working in OpenOffice Calc:
Option Explicit
Sub horizontal_filter()
'Erik Van Geit
'060910
Dim LC As Integer 'Last Column
Dim R As Long
Dim i As Integer
Dim FilterValue As String
Const FilterColumn = 1 '1 is most logical value but you may change this
R = ActiveCell.Row
LC = Cells(R, Columns.Count).End(xlToLeft).Column
FilterValue = Cells(R, FilterColumn)
Application.ScreenUpdating = False
'to filter starting after FilterColumn
For i = FilterColumn + 1 To LC
'to filter all columns even before the filtercolumn
'For i = 1 To LC
If i <> FilterColumn Then
Columns(i).Hidden = Cells(R, i) <> FilterValue
End If
Next i
Application.ScreenUpdating = True
End Sub
Any help is greatly appreciated!
You can't, under the assumption of reasonable expense. It's much easier just to transform your data so that rows get columns and vice versa. So, i would strongly recommend transforming the data using Paste Special together with the Transpose option. You could even do this dynamically by using the TRANSPOSE() function.
EDIT:
Now i got it - you want to hide columns based on a certain value. This is possible using a macro in fact, so my first answer was incorrect - sorry for that! There are some macros around that will do this for you. You can combine such a solution with an auto filter. Here's a solution by king_026 from the OpenOffice.org forums (slightly adapted to table structure - see below):
REM ***** BASIC *****
sub hide
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem get the current column
nCol = ThisComponent.CurrentSelection.CellAddress.Column
rem set the properties for moving right
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false
rem make thecurrent column counter
dim cCol as integer
CCol = 0
rem goto the first column
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$2"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem loop until you get back to the selected cell
Do Until cCol > nCol
rem hide if the cell value is 1
if ThisComponent.CurrentSelection.string <> "" and ThisComponent.CurrentSelection.value = 1 then
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:HideColumn", "", 0, Array())
End if
rem goto the right nad increment the column counter
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())
cCol = cCol + 1
Loop
End sub
So, the following table:
will look like this after Autofilter on Col1 and after the macro did his work: