E
eldon.l.lehman
The attributes of the shapes created by the code are made properties of
the shapes on the slide, but they do not show on the slide as having
taken effect by the run. Stepping through one line at a time not only
establishes the attributes, but reflectes them on the slide. Any
thoughts to the error in the programming?
Thank you,
Eldon
--------Begin code----------
Option Explicit
Public Sub fmtEq()
' Rectangle 2 of slide 1 contains the formula " Na2SO4",
' with a space preceding the N and no quotation marks
Dim lft As Double 'left position of textbox
Dim wth As Double 'width of textbox
Dim i As Integer 'increment of characters selected to format
Dim shpName As String 'name of text box shape
Dim prevShp As String 'name of text box shape on a loop prior to
current one
Dim txtRng As TextRange 'range of text to be formatted
Dim chRng As TextRange 'range of individual character to currently
format
'setting text range, initializing variables
Set txtRng = ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange
lft = 0
wth = 24
shpName = "Coef"
prevShp = "Rectangle 2"
For i = 1 To txtRng.Length
Set chRng = txtRng.Characters(i, 1)
Select Case Asc(chRng)
Case 32 'space
shpName = "Coef" & i
Case 48 To 57 'numbers
If Right(prevShp, 4) <> "Coef" Then shpName = "Sub" & i
Case 65 To 90 'Upper case
shpName = chRng
Case 97 To 120 'Lower case
shpName = chRng
End Select
With ActivePresentation.Slides(1)
.Shapes.AddShape(msoShapeRectangle, 0, 0, wth, 24) _
.Name = shpName
With .Shapes(shpName)
With .TextFrame
If chRng = " " Then
.TextRange = "1" 'Makes
coeficient start at 1
Else: .TextRange = chRng 'fills shape
with character if it is not a space
End If
.MarginLeft = 0 'set margins of
textframe
.MarginRight = 0
.AutoSize = ppAutoSizeShapeToFitText 'autosizes
shape to text contents
.TextRange.Font.Color.RGB = RGB(255, 255, 255)
End With
.Left = lft + wth 'moves shape to
position
.Top = 0
.Height = 24
.Fill.Visible = msoFalse
End With
'
If Left(shpName, 3) = "Sub" Then
..Shapes(shpName).TextFrame.TextRange.Font.Subscript = msoTrue
'sets variables for positioning next shape
lft = .Shapes(shpName).Left
wth = .Shapes(shpName).Width
prevShp = .Shapes(shpName).Name
End With
'' SlideShowWindows(1).View.GotoSlide 1
Next i
End Sub
---------End Code------------
the shapes on the slide, but they do not show on the slide as having
taken effect by the run. Stepping through one line at a time not only
establishes the attributes, but reflectes them on the slide. Any
thoughts to the error in the programming?
Thank you,
Eldon
--------Begin code----------
Option Explicit
Public Sub fmtEq()
' Rectangle 2 of slide 1 contains the formula " Na2SO4",
' with a space preceding the N and no quotation marks
Dim lft As Double 'left position of textbox
Dim wth As Double 'width of textbox
Dim i As Integer 'increment of characters selected to format
Dim shpName As String 'name of text box shape
Dim prevShp As String 'name of text box shape on a loop prior to
current one
Dim txtRng As TextRange 'range of text to be formatted
Dim chRng As TextRange 'range of individual character to currently
format
'setting text range, initializing variables
Set txtRng = ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange
lft = 0
wth = 24
shpName = "Coef"
prevShp = "Rectangle 2"
For i = 1 To txtRng.Length
Set chRng = txtRng.Characters(i, 1)
Select Case Asc(chRng)
Case 32 'space
shpName = "Coef" & i
Case 48 To 57 'numbers
If Right(prevShp, 4) <> "Coef" Then shpName = "Sub" & i
Case 65 To 90 'Upper case
shpName = chRng
Case 97 To 120 'Lower case
shpName = chRng
End Select
With ActivePresentation.Slides(1)
.Shapes.AddShape(msoShapeRectangle, 0, 0, wth, 24) _
.Name = shpName
With .Shapes(shpName)
With .TextFrame
If chRng = " " Then
.TextRange = "1" 'Makes
coeficient start at 1
Else: .TextRange = chRng 'fills shape
with character if it is not a space
End If
.MarginLeft = 0 'set margins of
textframe
.MarginRight = 0
.AutoSize = ppAutoSizeShapeToFitText 'autosizes
shape to text contents
.TextRange.Font.Color.RGB = RGB(255, 255, 255)
End With
.Left = lft + wth 'moves shape to
position
.Top = 0
.Height = 24
.Fill.Visible = msoFalse
End With
'
If Left(shpName, 3) = "Sub" Then
..Shapes(shpName).TextFrame.TextRange.Font.Subscript = msoTrue
'sets variables for positioning next shape
lft = .Shapes(shpName).Left
wth = .Shapes(shpName).Width
prevShp = .Shapes(shpName).Name
End With
'' SlideShowWindows(1).View.GotoSlide 1
Next i
End Sub
---------End Code------------