I'm trying to create a macro that will select any slide that contains a keyword in the title, but not getting anywhere. The ppt includes different frontpages, disclaimers and content slides and the idea is to add keywords to the titles of each slide and get the macro to select and export the selected slides to PDF.
I've got the export part working, but have the enter the slide numbers manually.
I got the code below from a similar question, but can't rewrite it to select the slides instead of presenting the answers as a MsgBox. Can somebody help, please?
Sub FindText()
Dim sld As Slide, shp As Shape, list As String, myPhrase As String
myPhrase = InputBox("enter a phrase", "Search for what?")
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If Left(shp.Name, 5) = "Title" Then
If Not shp.TextFrame.TextRange.Find(FindWhat:=myPhrase) Is Nothing Then
If list = "" Then list = sld.Name Else list = list & ", " & sld.Name
End If
End If
End If
Next shp
Next sld
MsgBox list
End Sub
My full code, using Steve's solution, if anyone is trying to solve the same problem:
Sub SelectedSlidesToPDF()
Dim sld As Slide, shp As Shape, list As String, myPhrase As String
myPhrase = "WhatYouLookFor"
For Each sld In Application.ActivePresentation.Slides
' FIRST, hide the slide:
sld.SlideShowTransition.Hidden = True
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If Left(shp.Name, 5) = "Title" Then
If Not shp.TextFrame.TextRange.Find(FindWhat:=myPhrase) Is Nothing Then
' UNHIDE the slides that contain your keywords
sld.SlideShowTransition.Hidden = False
End If
End If
End If
Next shp
Next sld
'EXPORT slides
ActivePresentation.ExportAsFixedFormat ActivePresentation.Path & "\" & "MySelectedSlides " & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint, RangeType:=ppShowAll
' UNIHDE all slides in presentation
For Each sld In ActivePresentation.Slides
sld.SlideShowTransition.Hidden = msoFalse
Next sld
End Sub
By default, when you save as PDF, the PDF won't include any slides that are hidden, so you can simply hide all the slides first, then UNHIDE any that you want to include in the PDF. While I haven't done this here, you'll want to UNHIDE all the slides again after saving to PDF.
For Each sld In Application.ActivePresentation.Slides
' FIRST, hide the slide:
sld.SlideShowTransition.Hidden = True
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If Left(shp.Name, 5) = "Title" Then
If Not shp.TextFrame.TextRange.Find(FindWhat:=myPhrase) Is Nothing Then
' UNHIDE the slides that contain your keywords
sld.SlideShowTransition.Hidden = False
End If
End If
End If
Next shp
Next sld
Related
Is there a way to update the alt text for multiple form control checkboxes at once using Excel VBA? I have about 20 check boxes on a worksheet {"Sheet1"} (Check Box 1, Check Box 2, ... Check Box 20) and need to change the text for all to = "In Progress". Thanks in advance!
"Finding and Replacing in Text Boxes
by Allen Wyatt
(last updated July 20, 2019)
Sub TextBoxReplace()
Dim shp As Shape
Dim sOld As String
Dim sNew As String
'Change as desired
sOld = "Old string"
sNew = "New string"
On Error Resume Next
For Each shp In ActiveSheet.Shapes
With shp.TextFrame.Characters
.Text = Application.WorksheetFunction.Substitute( _
.Text, sOld, sNew)
End With
Next
End Sub
This macro steps through all the shapes in the worksheet (text boxes are shapes) and then replaces whatever is in the sOld variable with whatever is in the sNew variable."
From excelribbon.tips.net
Disregard; I found a solution! ^_^
https://excelribbon.tips.net/T009264_Finding_and_Replacing_in_Text_Boxes.html
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 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 would like to add a [set of] standardized macro[s] to some of the cells of a custom spredsheet (Open/Libre/Star Office).
Said macro should be activated using a Form PushButton dropped into the relevant cell[s].
I experience several problems all relative to the access of the "relevant cell":
If I try to Anchor to Cell a PushButton it goes to A1 and not to currently selected cell.
I can connect a Basic fragment to the button, but I found no way to retrieve the "relevent cell" (i.e.: the cell containing the button).
What I am trying to do (as a first working example) is to add a button to increment the numeric value of the cell (possibly disabling direct editing; I want that value to go up by one at each button press and no way to otherwise change cell).
Is such a thing possible at all?
Any example (or pointer to docs) very welcome.
NOTE: This question gives some hints on how to solve problem in VBA (Excel), but I found nothing for [L|O|S]Office
You can find the cell containing the button from a handler as follows:
Sub ButtonHandler(oEvent)
Dim sControlName$
Dim oSheet
Dim nCount As Long
Dim i As Long
Dim oPage
Dim oShape
Dim oAnchor
sControlName = oEvent.source.model.Name
oSheet = thiscomponent.currentcontroller.activesheet
nCount = oSheet.drawpage.count
oPage = oSheet.drawpage
For i = 0 To nCount - 1
oShape = oPage.getbyindex(i)
'oControlShape = oPage.getbyindex(i).control
If (oShape.supportsService("com.sun.star.drawing.ControlShape")) Then
If oShape.control.Name = sControlName Then
oAnchor = oShape.anchor
If (oAnchor.supportsService("com.sun.star.sheet.SheetCell")) Then
Print "Button is anchored in cell: " + oAnchor.AbsoluteName
Exit For
End If
End If
End If
Next i
End Sub
I know, it is not pretty is it? I added significant error checking.If you then want to know what cell was active when you clicked the button, you can call this routine
Sub RetrieveTheActiveCell()
Dim oOldSelection 'The original selection of cell ranges
Dim oRanges 'A blank range created by the document
Dim oActiveCell 'The current active cell
Dim oConv 'The cell address conversion service
Dim oDoc
oDoc = ThisComponent
REM store the current selection
oOldSelection = oDoc.CurrentSelection
REM Create an empty SheetCellRanges service and then select it.
REM This leaves ONLY the active cell selected.
oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oDoc.CurrentController.Select(oRanges)
REM Get the active cell!
oActiveCell = oDoc.CurrentSelection
oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = oActiveCell.getCellAddress
Print oConv.UserInterfaceRepresentation
print oConv.PersistentRepresentation
REM Restore the old selection, but lose the previously active cell
oDoc.CurrentController.Select(oOldSelection)
End Sub
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