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.
Related
I am creating a powershell script that will auto generate publisher files for wristbands. On the Wristband is a QR code and a few other details to personally identify the wearer. I currently have a template file set up, a script that copies this, renames it, and edits some of the text on the page.
What I need it the script to change the placeholder image in the template to a QR code image, the data in the QR is only every going to be from a set amount of images (one of 1800), all have been generated and named to match up with the names used in Powershell.
Has anyone changed an image in MS Publisher using powershell before? Below is the code I currently have.
$CurrentMember = "M001S001"
$CurrectDocumet = "C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles\" + $CurrentMember + ".pub"
copy-item "C:\Users\Rob\Documents\DistrictCamp2017\TemplateWristband.pub" "C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles"
Rename-Item "C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles\TemplateWristband.pub" "$CurrentMember.pub"
Add-Type -AssemblyName Microsoft.Office.Interop.Publisher
$Publisher = New-Object Microsoft.Office.Interop.Publisher.ApplicationClass
$OpenDoc = $Publisher.Open("C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles\M001S001.pub")
###Replace Barcode and text
$pbReplaceScopeAll = 2
$OpenDoc.Find.Clear()
$OpenDoc.Find.FindText = "DEFAULT"
$OpenDoc.Find.ReplaceWithText = $CurrentMember
$OpenDoc.Find.ReplaceScope = "2" #$pbReplaceScopeAll
$OpenDoc.Find.Execute()
$OpenDoc.Save()
$OpenDoc.Close()
$Publisher.quit()
The image in the template document is currently a blank 145*145 pixel square, to be replaced by the appropriate QR code image, dependant on the value of $CurrentMember. I haven't yet written anything to try and change the image as I cannot find anything online, anything I search for seems to return results about Azure publisher server images.
Many thanks,
Rob
The easiest way is probably to get the shape by index, then add a new picture in its place, then remove the original shape:
Sub ReplaceFirstShapeWithImage()
Dim oPage As Page
Dim oShape As Shape
Dim newImage As Shape
Set oPage = Application.ActiveDocument.ActiveView.ActivePage
Set oShape = oPage.Shapes(1)
''https://msdn.microsoft.com/en-us/library/office/ff940072.aspx
Set newImage = oPage.Shapes.AddPicture("C:\Users\johanb\Pictures\X.png", msoFalse, msoTrue, oShape.Left, oShape.Top, oShape.Width, oShape.Height)
oShape.Delete
End Sub
This should help you find the right index
Sub GetIndexOfSelectedShape()
If Application.Selection.ShapeRange.Count = 0 Then
MsgBox "Please select a shape first"
Exit Sub
End If
Dim oShape As Shape
Dim oLoopShape As Shape
Dim i As Long
Set oShape = Application.Selection.ShapeRange(1)
For i = 1 To oShape.Parent.Shapes.Count
Set oLoopShape = oShape.Parent.Shapes(i)
If oLoopShape Is oShape Then
MsgBox oShape.Name & " has index " & i
End If
Next i
End Sub
Unfortunately I can't use PowerShell right now, but this VBA code should help you with the object model
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.
I used itext sharp to merge some pdf. After that, i want to delete them.
However itextsharp doesn't close the file, and File.Delete throws and exception.
This is my code:
Dim mergedPdf As Byte() = Nothing
Using ms As New MemoryStream()
Using document As New Document()
Using copy As New PdfCopy(document, ms)
document.Open()
'_listaPath is a List (of String) with the paths off all pdf to merge
For i As Integer = 0 To _listaPDF.Count - 1
Dim reader As New PdfReader(_listaPDF(i))
' loop over the pages in that document
Dim n As Integer = reader.NumberOfPages
Dim page As Integer = 0
While page < n
copy.AddPage(copy.GetImportedPage(reader, System.Threading.Interlocked.Increment(page)))
End While
Next
End Using
End Using
mergedPdf = ms.ToArray()
End Using
File.WriteAllBytes(fileexplorer.FileName, mergedPdf)
For Each pdfTMP In _listaPDF
If File.Exists(pdfTMP) Then
File.Delete(pdfTMP)
End If
Next
_listaPDF = New List(Of String)
I found the problem.
This line
Dim reader As New PdfReader(_listaPDF(i))
Should be
Using reader As New PdfReader(_listaPDF(i))
Conclusion, I need more coffee
I am extremely new to all of this, and whilst I have tried searching I cant find anything that has helped me achieve what I am after.
I have a form in VB with the following:
1 x tabcontrol
10 x checkboxes which sit in various tabs on the tab control
1 x listbox
When i tick any of the check boxes, I want their text to be added to the listbox, and when I untick, their text to be taken from the listbox.
I can achieve this very easily using if statements for the changedcheck event for each checkbox but I have to do that for every single checkbox which isn't very efficient as potentially i could have 20,30 40+ check boxes. Plus if I add one at a later stage I would have to remember to add its code.
Ideally i want a method that's says: check all the checkboxes in tabcontrol if there value is true write their text to a string, if there value is false, take there text from the string. put the string in the listbox.
I started with something like this...
Dim chk As CheckBox
Dim txt As String = ""
For Each chk In TabControl1.Controls
If chk.Checked = True Then
txt = txt + chk.Text +vbCrLF
Else
txt = replace(txt, chk.text + vbCrLf, "")
End If
Next
End Sub
First problem is that the above obviously doesn't work! so any guidance there is appreciated - i put it together from reading scraps from other code.
Second problem is, i can't get my head round how the list box will be updated, as previously i was using the CheckedChanged event for each control, which if i do what i want, then there wont be a specific CheckedChanged event, as it could be any of the checkboxes (hopefully that makes sense!). I don't want to have to press a button to add the checked checkboxes to the listbox, i want it to be dynamic
any help is very much appreciated.
For your first problem add
Dim chk As Control
Dim txt As String = ""
For Each chk In TabControl1.Controls
If TypeOf chk Is CheckBox
If DirectCast(chk, CheckBox).Checked = True Then
txt = txt + chk.Text +vbCrLF
Else
txt = replace(txt, chk.text + vbCrLf, "")
End If
End If
Next
End Sub
For your second problem in CheckedChanged event you can do something like this:
Private Sub OnCheckedChanged(sender as Object, e as EventArgs) _
Handles CheckBox1.CheckedChanged
Dim chk As CheckBox = TryCast(s, CheckBox)
Dim txt as string
If c.Checked = True Then
txt = chk.Text
EndIf
End Sub
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