Pretend I have a sentence like this:
"THIS IS MY CASE:"
":" is regular and I want to change its style like The character before it(E). But I don't know which object to use in this case. I want to find The index of ":" then I check Font Style of character before it (index - 1) if they are different I will change Font Style of charater ":" (index) to index - 1.
I try TextFrame.TextRange.Font but there was something wrong.
Please help me, thank in advance.
Try this code:
Sub test()
Dim sh As Shape, EF As Font, textLen As Integer
For Each sh In ActivePresentation.Slides(1).Shapes
If sh.HasTextFrame Then
textLen = sh.TextFrame.TextRange.Length
If textLen > 1 Then
Set EF = sh.TextFrame.TextRange.Characters(textLen - 1, 1).Font
With sh.TextFrame.TextRange.Characters(textLen, 1).Font
.Name = EF.Name
.Color = EF.Color
.Size = EF.Size
.Italic = EF.Italic
.Bold = EF.Bold
.Underline = EF.Underline
' and other required properties
End With
End If
End If
Next
End Sub
Related
I am trying to change the font color of specific text within a shape textframe (Multiple occurrence of the text within the same frame). This is what I currently have.
And this is what i am trying to achieve.
Basically finding the word "Capital:" and selecting that until the next space and changing it to the color red. (ex: Capital:Boston, Capital:Neveda, Capital:NewJersey).
The code i already have is this.
With OrgChart
With .Shapes("ChartItem" & OrgID).GroupItems("OrgTitle")
.TextFrame2.TextRange.Characters(1, 2).Font.Fill.ForeColor.RGB = RGB(255, 0, 255)
End With
End With
I need help with Character(x,x) feature - maybe an InStr function... not sure how that would work.
RegEx is a great choice for pattern matching the patterns on a PC.
Sub TestRegX()
Const Pattern As String = "Capital:*([^\s]+)"
Dim Shape As Shape
Set Shape = ActiveSheet.Shapes(1)
HighLightTextFrame2Matches Shape.TextFrame2, Pattern, RGB(255, 0, 255)
End Sub
Sub HighLightTextFrame2Matches(TextFrame2 As TextFrame2, Pattern As String, RGB As Long)
Dim RegX As Object
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.MultiLine = True
.Pattern = Pattern
End With
With TextFrame2.TextRange
If RegX.Test(.Text) Then
Dim Match As Match
For Each Match In RegX.Execute(.Text)
.Characters(Match.FirstIndex + 1, Match.Length).Font.Fill.ForeColor.RGB = RGB
Next
End If
End With
End Sub
InStr will work on both MAC and PCs.
Sub TestHighLightTextFrameSplit()
Const Match As String = "Capital:"
Dim Shape As Shape
Set Shape = ActiveSheet.Shapes(1)
HighLightTextFrameMatch Shape.TextFrame2, Match, RGB(255, 0, 255)
End Sub
Sub HighLightTextFrameMatch(TextFrame2 As TextFrame2, Match As String, RGB As Long)
Dim FirstIndex As Long, LastIndex As Long, Length As Long
FirstIndex = 1
With TextFrame2.TextRange
While InStr(FirstIndex, .Text, Match) > 0
FirstIndex = InStr(FirstIndex, .Text, Match)
LastIndex = InStr(FirstIndex, .Text, " ")
Length = LastIndex - FirstIndex
.Characters(FirstIndex, Length).Font.Fill.ForeColor.RGB = RGB
FirstIndex = FirstIndex + 1
Wend
End With
End Sub
I'm trying to make text in the data label of the chart with shadow effect (that shadow effect which you have at top of the PowerPoint menu), but I'm unable to make it work, dataLabels.shadow or dataLabels.font.shadow makes the frame shadowed, not the text.
I was googling a lot, I have found out this could be possible via TextFormat or TextFormat2 property, unfortunately I'm not able to access it for the text in the data label anyhow. My current code, lines after comment does not work:
For Each Shape In Slide.Shapes
If Shape.HasChart Then
Dim i As Integer
Dim v As Variant
Set pts = Shape.Chart.SeriesCollection(1).Points
For Each s In Shape.Chart.SeriesCollection
v = s.Values
If s.Name <> "XXX_XXX" Then
If v(pts.Count) >= 0.05 Then
s.Select
s.Points(pts.Count).Select
s.Points(pts.Count).ApplyDataLabels
s.DataLabels.Font.Color = s.Border.Color
s.DataLabels.Font.Size = 20
s.DataLabels.Font.Name = "Calibri"
's.DataLabels.Shadow = True
's.DataLabels.Font.Shadow = msoTrue
's.Points(pts.Count).DataLabel.Font.Shadow = msoTrue
's.Points(pts.Count).DataLabel(pts.Count).TextFrame.TextRange.Font.Shadow = msoTrue
End If
End If
Next s
End If
Next Shape
If someone will have problems with simillar case I have found the answer :)
The shadow (ribbon like shadow) for data label text/value is done via TextRange2 property, but I was missing Format. Like this :
Dim tr As TextRange2
Set tr = s.DataLabels(pts.Count).Format.TextFrame2.TextRange
With tr.Font.Shadow
.OffsetX = 10
.OffsetY = 10
.Size = 1
.Blur = 4
.Transparency = 0.5
.Visible = True
End With
Is there any simple and universal way to find out whether or not any character style has been assigned within the selected text?
Presently I'm using a function, but it is not independent of the MS Word language version:
Function AnyCharacterStyleAssigned()
'elicit the name of the default paragraph font
V_AppLang = Application.Language
If V_AppLang = 1031 Then
Vst_Default = "Absatz-Standardschriftart"
ElseIf V_AppLang = 1045 Then
Vst_Default = "Domy" & ChrW(347) & "lna czcionka akapitu"
ElseIf V_AppLan = 1033 Then
Vst_Default = "Default Paragraph Font"
Else
MsgBox prompt:="this script doesn't work for this language version of Word", Buttons:=vbOKOnly
End
End If
'search for the default paragraph font within the selection range
Set R_Range = Selection.Range
R_Range.Find.ClearFormatting
R_Range.Find.Style = Vst_Default
R_Range.Find.Execute findtext:="", Forward:=True, Wrap:=wdFindStop, Format:=True
AnyCharacterStyleAssigned = IIf(R_Range.Start >= Selection.End, False, True)
End Function
Just use built-in style constant:
Function AnyCharacterStyleAssigned()
'search for the default paragraph font within the selection range
Set R_Range = Selection.Range
R_Range.Find.ClearFormatting
R_Range.Find.Style = ActiveDocument.Styles(wdStyleDefaultParagraphFont)
R_Range.Find.Execute findtext:="", Forward:=True, Wrap:=wdFindStop, Format:=True
AnyCharacterStyleAssigned = IIf(R_Range.Start >= Selection.End, False, True)
End Function
A better test would be the following. The code you have, if the selection doesn't have the style, the selection never changes, so you will always have a True case.
Public Sub StyleTest()
Dim R_Range As Range
Set R_Range = Selection.Range
R_Range.Find.ClearFormatting
R_Range.Find.Style = "Strong"
Dim AnyCharacterStyleAssigned As Boolean
AnyCharacterStyleAssigned = False
If R_Range.Find.Execute(Forward:=True, Wrap:=wdFindStop, Format:=True) = True Then
R_Range.Select
AnyCharacterStyleAssigned = True
End If
End Sub
I am trying to change the text size in a textbox in Excel using VBA. I currently have the following code:
ActiveSheet.Shapes.Range(Array("textEnemy")).Visible = True
ActiveSheet.Shapes.Range(Array("textEnemy")).Select
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters
.Text = msg
For i = 1 To 15
.Font.Size = i * 10
Call WasteTime(50)
Next
End With
ActiveSheet.Shapes.Range(Array("textEnemy")).Visible = False
This code animates the text increasing in size, and then it disappears. The problem is that when I run this code the textbox is selected (there is a box around it). How can I achieve the same goal without selecting the textbox/showing the selection border around it?
Thanks!
As #findwindow says:
With ActiveSheet.Shapes.Range(Array("textEnemy"))
.Visible = True
With .ShapeRange(1).TextFrame2.TextRange.Characters
.Text = msg
For i = 1 To 15
.Font.Size = i * 10
Call WasteTime(50)
Next
End With
.Visible = False
End With
I found a solution. I had to set the textbox as a shape variable, and then adjust it.
Sub Animate(playerCode As Integer)
Dim i As Integer
Dim msg As String
Dim textBox As Shape
msg = "HIT!"
Set textBox = ActiveSheet.Shapes("textUser")
'Animate textbox
textBox.Visible = True
With textBox.TextFrame2.TextRange.Characters
.Text = msg
For i = 1 To 15
.Font.Size = i * 10
Call WasteTime(50)
Next
End With
textBox.Visible = False
End Sub
I am working on one project. In which i want to find out " Is my textbox going out of slide or not?" . If yes then show error msg.
so my logic is if i found the dimension of the slide then i will use it in IF...Else condition like :
If textbox_position < slide_dimension then
#Error
end if
If you have any other idea then please tell me.
Thanks
The presentation's .PageSetup.SlideWidth and .SlideHeight properties will give you the dimensions of the slide in points.
Your function would need to do something like (off top of head and out of the air ..):
Function IsOffSlide (oSh as Shape) as Boolean
Dim sngHeight as single
Dim sngWidth as Single
Dim bTemp as Boolean
bTemp = False ' by default
With ActivePresentation.PageSetup
sngHeight = .SlideHeight
sngWidth = .SlideWidth
End With
' this could be done more elegantly and in fewer lines
' of code, but in the interest of making it clearer
' I'm doing it as a series of tests.
' If any of them are true, the function will return true
With oSh
If .Left < 0 Then
bTemp = True
End If
If .Top < 0 Then
bTEmp = True
End If
If .Left + .Width > sngWidth Then
bTemp = True
End If
If .Top + .Height > sngHeight Then
bTemp = True
End If
End With
IsOffSlide = bTemp
End Function
Why you not use a placeholders of PowerPoint to make this? for example:
Sub SetText(IndexOfSlide As Integer, txt As String)
'http://officevb.com
ActivePresentation.Slides(IndexOfSlide).Shapes.Placeholders(1).TextFrame.TextRange.Text = txt
End Sub
You can call this sub and pass parameters
IndexOfSlide with a number of slide and txt with a text to create.