I want to find and replace all instances of the grave accent ` with the font named Rupee Forandian
Recently the rupee symbol was launched and there is no keyboard symbol for that...
When I try the excel replace function CRTL+H with the format function, it changes the font of the entire text string, while I want it to change only the grave accent `
I found a solution for Excel, but I need a similar one for Powerpoint 2007.
The VBA used in Excel is:
Sub InsertRupeeForandianSymbol()
Dim X As Long, Cell As Range
For Each Cell In Selection
For X = 1 To Len(Cell.Value)
If Mid(Cell.Value, X, 1) = "`" Then Cell.Characters(X, 1).Font.Name = "Rupee Foradian"
Next
Next
End Sub
Easiest way to do this I can think of would be
Sub InsertRupeeForandianSymbol()
Dim oSld As Slide
Dim oShp As Shape
Dim x As Long
Dim y As Long
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
For y = 1 To Len(oShp.TextFrame.TextRange)
If Mid(oShp.TextFrame.TextRange, y, 1) = "`" Then
oShp.TextFrame.TextRange.Characters(y).Font.Name = "Rupee Foradian"
End If
Next y
Next oShp
Next oSld
End Sub
In Powerpoint you have to iterate through Shapes to get texts:
Sub InsertRupeeForandianSymbol()
Dim sl As Slide, sh As Shape, X As Long
For Each sl In ActiveWindow.Selection.SlideRange
For Each sh In sl.Shapes
With sh.TextFrame.TextRange.Characters
For X = 1 To .Count
If .Characters(X, 1).Text = "'" Then .Characters(X, 1).Font.Name = "Rupee Forandian"
Next
End With
Next
Next
End Sub
This will change font for all currently selected slides. You may change ActiveWindow.Selection.SlideRange to ActivePresentation.Slides and apply to all slides in current presentation.
Related
Is there a way to align the text from right to left (it's Arabic) on all slides in a PowerPoint Presentation with a macro ? (I'm using O365).
In a Microsoft example I found this :
Application.ActivePresentation.Slides(1).Shapes(2) _
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
But i think that this example aligns the paragraphs of form 2 on slide 1 of the active presentation to the left.
So i don't know how to do it with all the shapes/slides types.
The professional coders may improve it, but I think this one should help you. You just have to select all slides before you click it, if you want the entire presentation to be done in one move. I think it is better than any entire-presentation-solution, because it gives you the opportunity to choose.
Option Explicit
Sub AlignAllTextLeft()
Dim osld As Slide
Dim oshp As Shape
Dim notesshp As Shape
Dim i As Long
Dim j As Long
Dim x As Long
On Error GoTo ErMsg
If MsgBox("You are going to change the text alignment of all text on all selected slides to left" & vbCrLf & "Continue?", vbYesNo) <> vbYes Then Exit Sub
For Each osld In ActiveWindow.Selection.SlideRange
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
oshp.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
End If
If oshp.HasTable Then
For i = 1 To oshp.Table.Rows.Count
For j = 1 To oshp.Table.Columns.Count
oshp.Table.Rows.Item(i).Cells(j).Shape.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
Next j
Next i
End If
Next oshp
For Each notesshp In osld.NotesPage.Shapes
If notesshp.HasTextFrame Then
notesshp.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
End If
Next notesshp
Next osld
For Each osld In ActiveWindow.Selection.SlideRange
For Each oshp In osld.Shapes
With oshp
Select Case .Type
Case Is = msoGroup
For x = 1 To .GroupItems.Count
If .GroupItems(x).HasTextFrame Then
oshp.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
End If
Next x
End Select
End With
Next oshp
Next
Exit Sub
ErMsg:
MsgBox "Please do not place the cursor between two slides"
End Sub
I would like to make an array (Set Selected_slds = ActivePresentation.Slides.Range) of slides. The slides are to be part of an array that can be selected from a number of Check boxes. So, the idea of the code I would like to write is:
Dim k As Integer
Dim list_of_slides As Array
Dim Selected_slds As SlideRange
For k = 1 To Count(CheckBoxs)
If CheckBox(k) = True Then
add.slide(k) to list_of_slides
End If
Next
Set Selected_slds = list_of_slides
The above is part of a longer code, where Selected_slds is used.
What I have done so far is this:
Sub Test()
Dim oSh As Shape
Dim oSl As Slide
Dim k As Integer
' Look at each shape on each slide in the active pres
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
' Is the shape a control?
If oSh.Type = msoOLEControlObject Then
' Is it a checkbox?
If InStr(UCase(oSh.OLEFormat.ProgID), "FORMS.CHECKBOX") > 0 Then
' BINGO, found what we're after, so ...
If oSh.OLEFormat.Object.Value = True Then
MsgBox "Checked"
ElseIf oSh.OLEFormat.Object.Value = False Then
MsgBox "Uncheked"
End If
End If
End If
Next ' Shape
Next ' Slide
End Sub
Which works, but I am not sure what to do, to get it to do what I am looking for. It is coded in power point.
I've just inherited an Excel app that draws an org chart. Each shape is connected by a Line
However, I need to remove the shadow that is drawn when each line is added. How do I get a collection of Lines so that I can do something like
Line.Shadow.Transparency = 1.0
I'm a bit of a vba newbie :-)
This should do the trick - it loops through all shapes, checks if they're a line, then removes the shadow.
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim shapeObj
For Each shapeObj In ActiveSheet.Shapes
If shapeObj.Type = 9 Then
Dim objName$
objName = shapeObj.Name
ws.Shapes.Range(Array(objName)).Shadow.Visible = msoFalse
End If
Next shapeObj
End Sub
Edit: Turns out, per OP, the shapes are grouped, so he used this to get it:
Sub RemoveLineShadows()
For Each Shp In ORG.Shapes
If Shp.Type = msoGroup Then
For X = 1 To Shp.GroupItems.Count
If Shp.GroupItems(X).Type = msoLine Then
Shp.GroupItems(X).Shadow.Transparency = 1
End If
Next X
End If
Next Shp
End Sub
Sub qqq()
Dim x As Shape
For Each x In ActiveSheet.Shapes
x.Shadow.Visible = msoFalse
Next
End Sub
I have several PowerPoints with a great deal of text in the notes. I need to search the note text and delete any paragraphs that start with "A."
Here is what I tried - but am getting type mismatch error
Dim curSlide As Slide
Dim curNotes As Shape
Dim x As Long
For Each curSlide In ActivePresentation.Slides
Set curNotes = curSlide.NotesPage.Shapes(2).TextFrame.TextRange
With curNotes.TextFrame.TextRange
For x = 1 To Len(curNotes.TextFrame.TextRange)
If Mid(curNotes.TextFrame.TextRange, x, 2) = "A." Then
curNotes.TextFrame.TextRange.Paragraphs = ""
End If
Next x
End With
Next curSlide
End Sub
Thanks for your help!!
You get a mismatch error whenever you try to assign data of a different type specified by your variable. This is happening in your code because you defined curNotes as type Shape and then tried to set that object variable to a different data type, TextRange. You are then trying to process the object TextRange as a string. You need to work on the .Text child of .TextRange The use of Mid is not checking the start of the string and finally, when you set the text to "", you are deleting all the text in the Note but that's not what you said you're trying to do.
This is the corrected code to delete only paragraphs starting with "A."
' PowerPoint VBA macro to delete all slide note paragraphs starting with the string "A."
' Rewritten by Jamie Garroch of youpresent.co.uk
Option Explicit
Sub DeleteNoteParagraphsStartingA()
Dim curSlide As Slide
Dim curNotes As TextRange
Dim iPara As Long
For Each curSlide In ActivePresentation.Slides
Set curNotes = curSlide.NotesPage.Shapes(2).TextFrame.TextRange
With curNotes
' Count backwards in any collection when deleting items from it
For iPara = .Paragraphs.Count To 1 Step -1
If Left(.Paragraphs(iPara), 2) = "A." Then
.Paragraphs(iPara).Delete
Debug.Print "Paragraph " & iPara & " deleted from notes pane on slide " & curSlide.SlideIndex
End If
Next
End With
Next curSlide
End Sub
In presentation mode, I want only unhidden slides to appear with consecutive page numbers. How can I avoid that hidden slides are counted?
Thank you Steve. I found an answer to my question elsewhere. The function below allows you to avoid that hidden slides are interfering with the slide numbers of unhidden slides in presentation mode.
Sub Number_NonHidden()
'For v.2007 onwards only
Dim osld As Slide
Dim objSN As Shape
Dim lngNum As Long
'check all slides
For Each osld In ActivePresentation.Slides
'Is it hidden
If osld.SlideShowTransition.Hidden Then
osld.HeadersFooters.SlideNumber.Visible = False
Else
osld.HeadersFooters.SlideNumber.Visible = True
Set objSN = getNumber(osld)
lngNum = lngNum + 1
If Not objSN Is Nothing Then ' there is a number placeholder
objSN.TextFrame.TextRange = CStr(lngNum + 1)
End If
End If
Next osld
End Sub
Function getNumber(thisSlide As Slide) As Shape
For Each getNumber In thisSlide.Shapes
If getNumber.Type = msoPlaceholder Then
If getNumber.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
'it's the slide number
Exit Function
End If
End If
Next getNumber
End Function
In order to avoid that the title slide is numbered insert lngNum = -1 as follows and delete the slide number box in the master title slide.
'check all slides
lngNum = -1
For Each osld In ActivePresentation.Slides
In VBA you'd do something like this:
Sub CountSlides()
Dim oSl As Slide
Dim x As Long
For Each oSl In ActivePresentation.Slides
If Not oSl.SlideShowTransition.Hidden Then
x = x + 1
End If
Next
MsgBox x
End Sub
In other words, if the SlideShowTransition.Hidden property of the slide is True, don't count it.