I have a PPT-Presentation with a number of charts. Each chart has data labels. These data labels are formated ##.##. I am trying to change it to ##.0 via VBA. Here is what I do:
Sub Format_Datalabels()
Dim Layout As CustomLayout
Dim Slide As Slide
Dim Shape As Shape
For Each Slide In ActivePresentation.Slides
For Each Shape In Slide.Shapes
With Shape
If .HasChart Then
With .Chart
For Each Point In .SeriesCollection(1)
.DataLabels.NumberFormat = "##.0"
End With
End If
End With
Next
End Sub
I guess, I am not actually getting a hold of the actual data labels. I am thrown the error "Method or data object not found". Any idea how I can actually format all data labels of all charts in a given presentation?
NumberFormat is poorly documented. In this context, 0 is not treated as a literal but as a special character. If there is a number in the first decimal position, then that number is displayed. If there is no number, then 0 will display, so 4 becomes 4.0, but 4.1 stays 4.1.
Normally in math, if every decimal number is 0, you don't display it at all. 4 is better than 4.0. But if you need to replace all first position decimals with 0, here's how:
.DataLabels.NumberFormat = "##"".0"""
Here, because .0 is in double double quotes, it's treated as a literal. I haven't tried debugging your code. Here's a macro that is tested as working:
Sub ChangeDataLabelNumberFormat()
With ActivePresentation.Slides(1).Shapes(1)
If .HasChart Then
With .Chart.SeriesCollection(1)
.HasDataLabels = True
.DataLabels.NumberFormat = "##"".0""" 'Displays all numbers as XX.0
End With
End If
End With
End Sub
Related
I have a Powerpoint-Slide with pasted, formatted source code in the form of text shapes. Sadly the contrast of some part of that text is bad on a projector, so I would like to change every colour occurence for a specific font with a different colour. In this specific example I want to replace the orange colour:
Iterating over all shapes and accessing the whole text of a shape is not a problem, but I can't find any property that allows me to enumerate over the styled text segments:
Sub ChangeSourceColours()
For Each pptSlide In Application.ActivePresentation.Slides
For Each pptShape In pptSlide.Shapes
If (pptShape.Type = 1) And (pptShape.TextFrame.TextRange.Font.Name = "Consolas") Then
' Iterate over styled segments and change them if the previous colour is orangey
MsgBox pptShape.TextFrame.TextRange
End If
Next
Next
End Sub
The TextRange2 property looked helpful at a first glance, but looking at the variables in the debugger I see nothing that looks like a series of formatted segments. I would expect to find something like <span> in HTML to check and possibly change the colour.
The textFrame2.textRange.Font is valid for the whole text. If you want to access the single characters and their individual formatting, you need to access textRange.Characters.
The following routine changes the text color for all characters that have a specific color to a new color:
Sub ChangeTextColor(sh As Shape, fromColor As Long, toColor As Long)
Dim i As Long
With sh.TextFrame2.TextRange
For i = 1 To .Characters.Length
If .Characters(i).Font.Fill.ForeColor.RGB = fromColor Then
.Characters(i).Font.Fill.ForeColor.RGB = toColor
End If
Next i
End With
End Sub
You call it from your code with
Dim pptSlide as Slide
For Each pptSlide In Application.ActivePresentation.Slides
Dim pptShape As Shape
For Each pptShape In pptSlide.Shapes
If (pptShape.Type = 1) And (pptShape.TextFrame.TextRange.Font.Name = "Consolas") Then
ChangeTextColor pptShape, RGB(255, 192, 0), vbRed
End If
Next
Next
You will have to adapt the RGB-Code to the orange you are using, or instead of using RGB, you can use ObjectThemeColor. To avoid a type mismatch, you need to declare the pptShape variable as Shape - you should declare all your variables and use Option Explicit anyhow.
Note that you can use the ChangeTextColor-routine also in Excel (and probably also in Word). Shapes are defined similar in Excel and Powerpoint. Advantage in Excel: You can use the macro recorder to get some insights how a Shape can be used in Office VBA.
I have a code that copies the bold text from textbox to the column 2 of the selected table. However
this code is not identifying the textboxes in a sequential manner and is copying the text from the textbox that was inserted first in the document and so on. This creates problem when the textboxes are not inserted sequentially. For example, if textbox 2 was inserted above textbox 1 in the document then the text from textbox 2 will be copied first in the table.
How can I reset the sequence of all textboxes so that the text is always copied from the first textbox to the last?
'This code copies bold text from the textboxes and insert into the column 2 of the selected table
Sub Copy_text_from_textbox_into_table()
Dim nNumber As Integer
Dim strText As String
Dim i As Long
Dim doc As Document
Dim tbl As Table
Dim rng As Range
Dim shp As Shape
Set doc = ActiveDocument
Selection.Collapse Direction:=wdCollapseStart
Set tbl = Selection.Tables(1)
i = 0
With doc
For Each shp In .Shapes
If shp.Type = msoTextBox Then
Set rng = shp.TextFrame.TextRange
With rng.Find
.Font.Bold = True
.Wrap = wdFindStop
.Execute
strText = rng.Text
End With
i = i + 1
With tbl.Cell(Row:=i + 1, Column:=2).Range
.Delete
.InsertAfter Text:=strText
End With
Else
MsgBox ("There is no textbox.")
End If
Next
End With
End Sub
The issue you're dealing with is the position in which the textboxes are anchored. This is the place in the document's text flow where the Shape is managed. If you were to look at the underlying XML you could see how this works (but that's not necessary for understanding what's happening). In order to see these anchors, go to File/Options/Display and activate "Object anchors" in the section "Always show these formatting marks on the screen". (Note: these do not print out; another term for them is "non-printing characters".)
Generally, when the user inserts a text box, it will anchor to the paragraph in which the selection is located. If the text box is then dragged, the anchor will move, unless it's been explicitly "locked" in position. When code inserts a text box, it will anchor to the Range specified by the Anchor parameter; if that's not set, it's a bit of a lottery.
When Word runs through the Shapes collection it follows the contiguous text in the document, picking up the Shapes in the order of the anchors, no matter where the object might appear on the page.
A complete solution to this very complex requirment goes beyond the scope of Stack Overflow. The following illustrates the basics about what's involved and how it can be approached.
A simple approach
An approach to solving this would be to loop the Shapes, adding each object to an array or collection. Check the vertical / horizontal positions of each object in the array (or collection), relative to the page margins. Then sort the array/collection according to this information. Finally, go through the sorted array/collection and assign the content to the table.
Doing this is further complicated by the fact that Shape positions can be relative to the anchor point, to a margin or to a page.
The following code shows a possible approach to getting the text boxes in the correct order (top-to-bottom) as they appear on a page.
For the sake of clarity, the step of writing the content to a table has been left out, but a comment is inserted at the point this would take place.
The code
The code performs three Forloops. The first loops all Shapes in the document and tests whether each is a text box. If it is, the required properties are written to a user-defined Type, then the Type is assigned to an array. This is done for reasons of efficiency: looping an array of a Type is faster than addressing each Shape object again, in a later loop.
Note also, before each iteration, the Shape is explicitly set to be positioned relative to the page, rather than anything else. This means that the text boxes will not move on the page with the text. If this is required, another level of complexity needs to be added to ascertain how each text box is positioned, relatively, and calculate the position relative to the page based on that. (Or, it might be possible to change the setting back, but that would need to be tested to make sure the text boxes do not move. In any case, such a level of complexity goes beyond the scope of this question.)
Since we need both the Shape object (or a way to identify that object) and its positional information, a multi-dimensional array is needed. The number of elements (TextBoxes) is unknown when the code starts, so the array needs to be dimensioned during run-time. But Redim Preserve can only change the last dimension, so is not suited to this purpose. Therefore, the information cannot be assigned directly to the multi-dimensional array, which is why it's first assigned to an array of the user-defined Type, which carries all the information.
After dimensioning the array, the positional information is assigned to it from the array of the Type, along with an index value. At the same time, a third array, with the index value and the name of the Shape is populated.
The reason for the third array is that WordBasic.SortArray is used to sort the array by the Top position of the Shapes on the page. This coerces all elements into the same data type, meaning the string value of the Shape.Name is not retained.
Finally, the code loops the sorted array, which is now in ascending order of each text box on the page.§
Public Type DocShapes
shpName As String
top As Double
left As Double
End Type
Sub GetTextBoxPositionalOrder()
Dim doc As Word.Document
Dim shp As Word.Shape
Dim aShapes() As Variant
Dim counter As Long, i As Long
Dim shpType As DocShapes
Dim shpTypes() As DocShapes
Dim shpIndex() As Variant
counter = 0
Set doc = ActiveDocument
For Each shp In doc.Shapes
'Count the shapes to dimension the array and
'assign to user-defined Type
If shp.Type = msoTextBox Then
shp.RelativeVerticalPosition = wdRelativeVerticalPositionPage
shp.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
shpType.shpName = shp.Name
shpType.left = shp.left
shpType.top = shp.top
ReDim Preserve shpTypes(counter)
shpTypes(counter) = shpType
counter = counter + 1
End If
Next
ReDim Preserve aShapes(counter - 1, 2)
ReDim Preserve shpIndex(counter - 1, 1)
For i = LBound(shpTypes) To UBound(shpTypes)
shpIndex(i, 0) = i + 1
shpIndex(i, 1) = shpTypes(i).shpName
aShapes(i, 2) = i 'corresponds to the index
aShapes(i, 0) = shpTypes(i).top
aShapes(i, 1) = shpTypes(i).left
Next
WordBasic.SortArray aShapes, 0, 0, UBound(aShapes), 0, 0
For i = LBound(aShapes) To UBound(aShapes)
'''Write the text box content to the table at this point
Debug.Print shpIndex(aShapes(i, 2), 1), aShapes(i, 0), aShapes(i, 1)
Next
End Sub
§ Note that this code works for a one-page document. If you need to handle text boxes on multiple pages, then an added dimension is required: on which page each Shape is located. Then the text box information would first need to be sorted by page, and then by position on each page. Or set it up to work with one page's Shapes at a time.
It would also be possible to use a different sort algorithm - there are a lot out there. I used WordBasic.SortArray because 1) it's built-in and 2) I couldn't take the time to research various sort algorithms.
I have a few textboxes in a slide. Each of them have different font sizes.
The text in the textbox are multi-line. But their line-breaks are word-wrapped, not manual carriage returned.
I need to convert those word-wrapped text to proper carriage-returned text, so i can export it to a CSV text file.
I have many Powerpoint presentation files, with hundreds of slides in each file. And each slide a few wordwrapped textboxes with different font sizes.
How should i solve this problem?
Hope someone can point me to the right direction.
Thanks!
Here's something to get you started:
Sub TestIt()
Dim osh As Shape
Set osh = ActiveWindow.Selection.ShapeRange(1)
Call WordwrapToLineEnd(osh)
End Sub
Function WordwrapToLineEnd(osh As Shape)
Dim x As Long
With osh.TextFrame.TextRange
For x = 1 To .Lines.Count
.Lines(x).Text = .Lines(x).Text & vbCrLf
Next
End With
End Function
Basically, I am not much of a programmer and do a lot of drawing and diagramming in PowerPoint for education purposes. I currently use PowerPoint 2016. To increase my workflow speed, I map keyboard shortcuts to macro keys on my keyboard so I get the functionality just by hitting a key on the keyboard.
I am trying to find a macro that I can link to a keyboard shortcut allowing me to increment the rotation of the currently selected shape to … let’s say 2 degrees each time I hit the shortcut.
I'm new to ppt vba. After doing some research so far here is what I came up with. But it doesn't seem to be working.
Public Sub RotateCW2()
Dim shp As Shape
Set shp = ActiveWindow.Selection.ShapeRange(1)
shp.Rotate = shp.Rotate + 2
End Sub
Appreciate the help!
After mix and matching things arround, I think this one is working.
Sub Rotate()
With ActiveWindow.Selection.ShapeRange
.IncrementRotation 2
End With
End Sub
and it works as intended. Thanks guys for your answers.
You were almost there. Try this instead:
Public Sub RotateCW2()
Dim shp As Shape
Set shp = ActiveWindow.Selection.ShapeRange(1)
shp.Rotation = shp.Rotation + 2
End Sub
From Thomas' answer I figured I might try this.
Public Sub RotateCW2()
Dim shp As Shape
Set shp = ActiveWindow.Selection.ShapeRange(1)
shp.Rotate = shp.IncrementRotation(2)
End Sub
This time I get the error "Compole error: Expected Function or variable" and it highlights (.IncrementRotation).
The Shape Object has a series of Increment properties to choose from.
Note: Descriptions copied from MSDN
IncrementRotation( Increment )
"Specifies how far the shape is to be rotated horizontally, in degrees. A positive value rotates the shape clockwise; a negative value rotates it counterclockwise."
IncrementRotationX( Increment )
"Specifies how much (in degrees) the rotation of the shape around the x-axis is to be changed. Can be a value from ? 90 through 90. A positive value tilts the shape up; a negative value tilts it down."
IncrementRotationY( Increment )
"Specifies how much (in degrees) the rotation of the shape around the y-axis is to be changed. Can be a value from ? 90 through 90. A positive value tilts the shape to the left; a negative value tilts it to the right."
Public Sub RotateCW2()
Dim shp As Shape
Set shp = ActiveWindow.Selection.ShapeRange(1)
shp.Rotate = shp.IncrementRotation 2
End Sub
I am working with a pie chart and a legend in Excel 2003.
The legend entries are composed of strings like this:
75% Ice Cream
20% Brownies
5% Gummy Bears
I am trying to put the exposure percentage in bold but leave the rest of the series name (Ice Cream, Brownies, or Gummy Bears) in regular font.
Is it possible to do this?
So far I have been working with variations on this code. In addition, I have tried using the Split() function on the SeriesCollection object and even recording a macro to see what Excel would generate in VBA. Thus far I can only get the text to appear in all bold, or all regular font, and not a mix of the two.
For x = 1 To 3
myChartObject.Chart.Legend.LegendEntries(x).Font.Bold = True
Next x
Suggestions would be helpful.
I didn't catch the fact that you're working in a chart, but hopefully the below can help. If you can get the characters, then you can bold certain parts of a string. (Assuming your column A has a cell with 20% Brownies, the next cell 75% Ice Cream, etc.)
Sub boldPercent()
Dim i&, lastRow&, percentLength&, percentAmt$
Dim k&
lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' Assuming your data is in column A
For i = 1 To lastRow
percentAmt = Left(Cells(i, 1), WorksheetFunction.Search("%", Cells(i, 1)))
percentLength = Len(percentAmt)
With Cells(i, 1).Characters(Start:=1, Length:=percentLength)
.Font.Bold = True
End With
Next i
End Sub
So perhaps you can use that and tweak it to work with the chart area? Have VBA loop through your chart titles, and perhaps you can use the same method above.
Edit: I'm making a mock example chart to try and work on this - but how are you getting the percentages of each category into the Legend? I have set up a super simple chart, but don't know where you went from here (screenshot)
(I'm expecting your legend to say 75% Ice Cream, 20% Brownies, etc. right?)
Edit2: Okay, I have moved into using the Chart object, hoping to grab each Legend Entry, and would feather in the bolding of characters as I did above...however, I can't get legendStringever to be a non-empty string:
Sub Bold_Legend_Text()
Dim stringToFind$
Dim cObj As ChartObject
Dim legEnt As LegendEntry
Dim cht As Chart
Dim i&
Dim percentLength&
Dim legendString$
stringToFind = "%"
For Each cObj In ActiveSheet.ChartObjects
Set cht = cObj.Chart
With cht
If .HasLegend Then
Debug.Print .Legend.LegendEntries.Count
For Each legEnt In .Legend.LegendEntries
' This always returns an empty string, not sure why!
legendString = legEnt.Format.TextFrame2.TextRange.Characters.Text
Debug.Print legendString
' Then we'd find where "%" shows up in the Legend title, and try to bold
' just certain characters
Next legEnt
End If
Next cObj
End Sub
(Thanks to this thread)