I am trying to use VBA to manipulate text in a PowerPoint.
I have formatted text in a frame with greek symbols, superscript and subscript.
I want to divide that text into two frames.
For example I use something like this:
Dim frame1Text As String
Dim frame2Text As String
Set frame1 = ActivePresentation.Slides(1).Shapes(1).TextFrame
Set frame2 = ActivePresentation.Slides(1).Shapes(2).TextFrame
frame1Text = frame1.TextRange.Text
frame2Text = Right(frame1Text, Len(frame1Text) - 10)
frame1Text = Left(frame1Text, Len(frame1Text) - Len(frame2Text))
frame1.TextRange.Text = frame1Text
frame2.TextRange.Text = frame2Text
As a result there are symbols and formatting lost. Is there any way to make it better?
Thanks for any help.
If possible, I would duplicate the shape and then delete what you don't want in the text. That way all formatting will be retained, character-by-character. Something along the lines of this:
Option Explicit
Sub CopyText()
Dim oShp1 As Shape
Dim oShp2 As Shape
Set oShp1 = ActivePresentation.Slides(1).Shapes(1)
oShp1.Copy
ActiveWindow.View.Slide.Shapes.Paste
Set oShp2 = ActivePresentation.Slides(1).Shapes(ActivePresentation.Slides(1).Shapes.Count)
With oShp1.TextFrame.TextRange
.Text = Left(.Text, 10)
End With
With oShp2.TextFrame.TextRange
.Text = Right(.Text, Len(.Text) - Len(oShp1.TextFrame.TextRange.Text))
End With
End Sub
Related
I want to ask for a letter color in an If conditional:
string="asdfghjkl"
for i=1 to len(string)
letter = mid(string, i, 1)
input_letter = inputbox("Write a letter")
if letter = input_letter 'and letter.Font.Color = RGB(31,78,120)
'my code here
endif
next
The and letter.Font.Color = RGB(31,78,120) is not working. It says i need an object.
Is there any similar way to ask this? This RGB color is blue, and I am using this code to transform the entire sentence to blue (with the record macro excel setting)
With Selection.Font
.ThemeColor = xlThemeColorAccent1
.TintAndShade = -0.499984740745262
End With
Thanks
Regarding your question's problem:
The .Font.Color is a property of the class Range, but in your line of code:
if letter = input_letter 'and letter.Font.Color = RGB(31,78,120)
... you're trying to access this property in the variable letter, which is a String (you don't explicitly declare it as such, but it gets automatically declared when you execute letter = mid(string, i, 1) just above).
That is why you get an Object required exception: you're trying to access the property .Font.Color on something that is not a Range object (actually, not an Object at all).
Regarding your real need:
I'm not sure to understand what you're trying to do. Are you trying to reach a multi-colored text into a single cell in Excel? If I've got it right, you'll have a string:
string="asdfghjkl"
(please note: you can't call your variable String, that's a reserved keyword for the code. Think of calling it something else, though I guess you already do that in your real code or you wouldn't be able to execute it at all).
... and, for each letter of that string,
for i=1 to len(string)
... you want the user to give you a color. In that case, you can't do it in Excel. If not that, could you please express better your real need?
The code below comes closest to your OP logic and comment using the .Characters property of a cell Range (B11) containing your string value:
Code
Option Explicit
Sub test()
Dim blue As Long: blue = RGB(31, 78, 120)
Dim s As String: s = "asdfgh"
Dim letter As String
Dim input_letter As String
Dim i As Integer
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("MySheet").Range("B11")
With rng
.Value = s
' color whole string
.Characters(1, Len(s)).Font.Color = blue
For i = 1 To Len(s)
letter = Mid(s, i, 1)
input_letter = InputBox("Write a letter")
If letter = input_letter And .Characters(i, 1).Font.Color = blue Then
'color found character
.Characters(i, 1).Font.Color = vbWhite
ElseIf input_letter = "" Then Exit For
End If
Next
End With
End Sub
Notes
Always use Option Explicitin your modules declaration head. So you would see that String isn't allowed as variable name as it's a function.
The extra color check in the If condition seems redundant, as characters so long a r e blue.
You seem to prefer repeated InputBoxes within the For - Next loop, could be reduced to a single call.
I'm working on Visio 2013 for a project and I'm new to VBA and Visio.
First, I wrote a function which imports a CSV file in the current visio document by creating first a string table texte of the CSV and then adding it in a shape:
Dim sp As Visio.Shape
Set sp = ActiveDocument.Pages(1).Drop(Visio.ActiveDocument.Masters("Puce 120"), 4, 10)
sp.Characters.Text = texte
Now I want to write the reverse function, from the shape to a CSV file but I can't find a way to access the text in my shape "Puce 120".
I wrote this:
Dim vsoMasters As Visio.Masters
Dim intMasterCount As Integer
Dim intCounter As Integer
Dim vsoMaster As Visio.Master
Set vsoMasters = ActiveDocument.Masters
intMasterCount = vsoMasters.Count
If intMasterCount > 0 Then
For intCounter = 1 To intMasterCount
If vsoMasters.Item(intCounter).Name = "Puce 120" Then
Set vsoMaster = vsoMasters.Item(intCounter)
End If
Next intCounter
Else
Debug.Print " No masters in document"
End If
Dim shap As Visio.Shapes
Set shap = vsoMaster.Shapes
Dim ch As Visio.Characters
ch = shap.Characters
But I don't find my text in ch. Can someone explain me how to retrieve it?
You can put and get text of a shape using shape.Text property.
Is there any reason for all other fancy stuff? That is, you can set shape text like this:
shape.Text = "Hello"
And get it back like this:
myText = shape.Text
I have a PowerPoint slide with 5 shapes on it. I would like to do different things with theses shapes in a macro. How can I change one of these shapes by using the shape ID? For example, I have two shapes with a name of "Title 1" but I want to use the one with an ID of 15.
Here is my code:
Sub size_n_spread_v()
Dim j As Integer
Dim sld As Slide
Dim SldId As Long
gap = std_gap
SldId = ActiveWindow.View.Slide.SlideIndex
Set sld = ActivePresentation.Slides(SldId)
Call SortMultArray
new_dim = (total_dim - gap * (lngRow - 1)) / lngRow
'This works but is not specific:
'sld.Shapes.("Title 1").Height = new_dim
'This would hopefully be specific but the syntax does not work Please HELP!
'sld.Shapes.("Title 1").Id(15).Height = new_dim
End Sub
Does someone know the right syntax to change the shape via ID?
I don't know of a way, but you could write a simple helper function that you could then use throughout your project to make things easier on yourself. Something like this would work:
Public Function GetShapeById(s As Slide, n As String, id As Long) As Shape
Dim objShape As Shape
For Each objShape In s.Shapes
If StrComp(objShape.Name, n, vbTextCompare) = 0 And objShape.Id = id Then
Set GetShapeById = objShape
Exit Function
End If
Next
End Function
Then you could use it like so:
Sub size_n_spread_v()
....
' Instead of:
sld.Shapes.("Title 1").Id(15).Height = new_dim
' Use:
GetShapeById(sld, "Title 1", 15).Height = new_dim
End Sub
The function mentioned above is the only way to get a shape by Id. You have to search through the Shapes collection as there is no equivalent ShapeIndex as there is for SlideIndex. The other solution to find a specific shape is to uniquely identify shapes by adding your own Tag but this is a more complex solution.
I have a line (=autoshape) drawing object on an Excel spreadsheet. I want to determine which cell it "points" to. For this I need to know the coordinates of the start and end points.
I can use .Top, .Left, .Width, .Height to determine bounding rectangle, but the line may be in 2 different positions in that rectangle.
To do this you must use the members HorizontalFlip and VerticalFlip. The following function should do what you want:
Function CellFromArrow(ByVal s As Shape) As Range
Dim hFlip As Integer
Dim vFlip As Integer
hFlip = s.HorizontalFlip
vFlip = s.VerticalFlip
Select Case CStr(hFlip) & CStr(vFlip)
Case "00"
Set CellFromArrow = s.BottomRightCell
Case "0-1"
Set CellFromArrow = Cells(s.TopLeftCell.Row, s.BottomRightCell.Column)
Case "-10"
Set CellFromArrow = Cells(s.BottomRightCell.Row, s.TopLeftCell.Column)
Case "-1-1"
Set CellFromArrow = s.TopLeftCell
End Select
End Function
This code is tested in Excel 2010. Seems to work. Hope this helps!
EDIT:
If you have to worry about shapes contained in groups, then it seems the only solution is to ungroup, iterate through the shapes and then regroup. Something like the following:
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = msoGroup Then
Dim oldName as String
Dim sGroup As GroupShapes
Dim GroupMember as Shape
Set sGroup = s.GroupItems
oldName = s.Name 'To preserve the group Name
s.Ungroup
For Each GroupMember in sGroup
'DO STUFF
Next
Set s = sGroup.Range(1).Regroup 'We only need to select one shape
s.Name = oldName 'Rename it to what it used to be
End If
Next
You can refer to ShapeRange Documentation for more info on the Regroup method.
Let me know if this works for you!
I'm using VBA to create some graphics I need to do.
Basically, what I want to do is to create the 1st series automatically and then, the 2nd series, copy the color and format from the 1st series.
I'm trying to do this code but with no success:
ActiveChart.SeriesCollection(a - 1).Select
ActiveChart.SeriesCollection(a).Border.ColorIndex = ActiveChart.SeriesCollection(a - 1).Border.ColorIndex
ActiveChart.SeriesCollection(a).MarkerBackgroundColorIndex = ActiveChart.SeriesCollection(a - 1).MarkerBackgroundColorIndex
ActiveChart.SeriesCollection(a).MarkerForegroundColorIndex = ActiveChart.SeriesCollection(a - 1).MarkerForegroundColorIndex
ActiveChart.SeriesCollection(a).MarkerStyle = ActiveChart.SeriesCollection(a - 1).MarkerStyle
Can someone please help me on how to read the properties from the previous series and apply them to the next?
Thanks.
In general something like this could work:
Sub Tester()
Dim Cht as Chart
Dim a As Series, b As Series, x As Long
Set cht = ActiveChart
Set a = cht.SeriesCollection(1)
For x = 2 To cht.SeriesCollection.Count
Set b = cht.SeriesCollection(x)
b.Border.Color = a.Border.Color
b.MarkerBackgroundColor = a.MarkerBackgroundColor
b.MarkerForegroundColor = a.MarkerForegroundColor
b.MarkerStyle = a.MarkerStyle
Next x
End Sub
Note however that some properties will not be read unless the first series was manually formatted, and is not just the "default" format.
Eg: see Fill and Border color property of data point marker (scatter or line) Excel VBA for similar problem.