I would like to create a simple macro for powerpoint that would allow me to click on one button to automatically insert a yellow sticky note onto my slide so I can insert a comment. This is something I need to do over and over in my current job and right now I am wasting a lot of time, each time creating a rectangle -> coloring it yellow -> creating a black outline -> setting font color to red and size to 12..
Appreciate any help here, I know it should not be very hard!
Thanks!
example of standard stickynote on a slide (at scale)
I wrote this for you and hope it helps.
Sub insert_sticky_note()
Dim mySlide As PowerPoint.Slide
Dim myTextbox As PowerPoint.Shape
Set mySlide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber)
Set myTextbox = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=10, Width:=200, Height:=50)
myTextbox.Fill.BackColor.RGB = RGB(250, 246, 0) 'yellow
myTextbox.Fill.Transparency = 0.2 'translucent
myTextbox.Height = 150
myTextbox.Width = 300
myTextbox.TextFrame2.AutoSize = msoAutoSizeTextToFitShape 'https://www.pcreview.co.uk/threads/how-to-vba-code-shrink-text-on-overflow.3537036/#post-12183384
With myTextbox.TextFrame.TextRange
.Text = "Note"
'With .Font
' .Size = 12
' .Name = "Arial"
'End With
End With
End Sub
Related
Win10x64 Office 365 PPT v 16.0.12325.202080 64-bits
I need to show a character with a yellow font color but a black outline, for readability purposes. This character goes inside a Powerpoint table Cell.
The following link has a method that I'm currently using that consists of creating a dummy shape, adding text to it, modify the shape's textframe2 textrange font line properties and then copying it and pasting it back to the table cell.
http://www.vbaexpress.com/forum/archive/index.php/t-43787.html
This was asked 8 years ago, but I'm currently seeing the same behaviour where we can't directly manipulate the textframe2 wordart format of text inside a cell. The program doesn't show an error but doesn't work.
I have given up on trying to modify the textrame2 textrange font line properties directly from VBA.
I have managed to get it to activate the font outline color using
Application.CommandBars.ExecuteMso ("TextOutlineColorPicker")
After it's activated I thought I could modify the textframe2 textrange font line properties, but it still doesn't work.
Is there an Application.CommandBars idMso for changing the font outline color and font outline line width inside a table cell?
Or another other than pasting the formatted text inside a table cell.
Edit:
Adding an image to illustrate what I mean by text color and text outline color and the menu used to show them in red circle:
Edit2
Added another snapshot to exemplify a character inside a cell with black outline and a character inside a cell without an outline
Thanks
Here's an example to access a Table on a given slide and change one cell's attributes. The example slide I'm using looks like this
The code itself creates a function that allows you to select a table from a particular slide, and a single cell within the table and highlight it.
Option Explicit
Sub test()
HighlightTableCell 1, 2, 3
End Sub
Sub HighlightTableCell(ByVal slideNumber As Long, _
ByVal thisRow As Long, _
ByVal thisCol As Long)
Dim theSlide As Slide
Set theSlide = ActivePresentation.Slides(slideNumber)
Dim shp As Shape
For Each shp In theSlide.Shapes
If shp.Type = msoTable Then
Dim theTable As Table
Set theTable = shp.Table
With theTable.Cell(thisRow, thisCol)
With .Shape.TextFrame2.TextRange.Characters.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
With .Shape.TextFrame2.TextRange.Characters.Font.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With
End With
End If
Next shp
End Sub
This question should be answered by Microsoft Office developers.
Currently, to overcome this bug-some situation, I think, copying the formatted text outside the table and pasting it into a table cell is the only work-around for this trouble.
As you mentioned, according to John Wilson, one of the most brilliant PowerPoint MVPs(http://www.vbaexpress.com/forum/archive/index.php/t-43787.html), if we copy the text from a textbox or shape that is located outside of the table, the format of the text can be preserved even for the text in a table cell.
Option Explicit
Sub test()
Dim shp As Shape, tshp As Shape
Dim sld As Slide
Dim tbl As Table
Dim r%, c%
If ActiveWindow.Selection.Type = ppSelectionNone Then MsgBox "Select a table first.": Exit Sub
Set shp = ActiveWindow.Selection.ShapeRange(1)
Set sld = shp.Parent
'add a temporary textbox for copying the formatted text into a cell
Set tshp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 541, 960, 540)
tshp.Visible = False
Set tbl = shp.Table
For r = 1 To tbl.Rows.Count
For c = 1 To tbl.Columns.Count
'1) cell -> 'tshp'
tbl.Cell(r, c).Shape.TextFrame2.TextRange.Copy
tshp.TextFrame2.TextRange.Paste
'2) outline the text in 'tshp'
With tshp.TextFrame2.TextRange.Font.Line
.Visible = msoTrue
.Weight = 0.2
.ForeColor.RGB = RGB(255, 127, 127)
End With
'3) 'tshp' -> cell
tshp.TextFrame2.TextRange.Copy
tbl.Cell(r, c).Shape.TextFrame2.TextRange.Paste
'// the code below doesn't work
'With tbl.Cell(r, c).shape.TextFrame2.TextRange.Characters.Font.Line
'With tbl.Cell(r, c).shape.TextFrame2.TextRange.Font.Line
' .Visible = msoTrue
' .Weight = 0.5
' .ForeColor.RGB = RGB(255, 127, 127)
'End With
Next c
Next r
'remove the tempoarary textbox
tshp.Delete
End Sub
The above snippet creates a temporary textbox on left-top area of the slide and applies the outlined text format. Then, it copies the content of each cell to the temporary textbox and copy/paste the formatted text back to the cell. By using this method, we can apply the outlined text format to the text in a cell.
I am trying to change the text color of the chart title of a histogram chart in PowerPoint.
Here is what I do:
var colorFormat = chart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor;
colorFormat.RGB = ...;
// or
colorFormat.ObjectThemeColor = ...;
This works for the standard charts like line charts. But it doesn't work for other chart types like histogram, waterfall, tree map etc.
In these cases, setting ObjectThemeColor sets the text to black. Setting RGB does actually set the correct color. However, in both cases, as soon as the user changes the selection, the text color jumps back to the one it had previously.
How can I set the text color of the title of one of these charts?
I am using VSTO and C# but a VBA solution is just as welcome as long as it can be translated to C# and still work.
Based on what info you gave I built a histogram and waterfall chart in PowerPoint and was successful using:
Sub ChartTitleFontColor()
Dim oShp As Shape
Dim oCht As Chart
'Waterfall on slide 1
Set oShp = ActivePresentation.Slides(1).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then
Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
'Histogram on slide 2
Set oShp = ActivePresentation.Slides(2).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
' Clean up
Set oShp = Nothing
Set oCht = Nothing
End Sub
Your code works in my test. I created two charts in PowerPoint 2016, the first one a waterfall, and the second another type. The following code changes the title color only (and text just a proof of it being changed) and nothing else. I can select the other chart and nothing changes. I could not find a bug about this in a search. Perhaps something in the remaining code is changing it back?
Sub test()
Dim myPresentation As Presentation
Set myPresentation = ActivePresentation
Dim myShape As Shape
Set myShape = myPresentation.Slides(1).Shapes(1)
Dim theChart As Chart
If myShape.HasChart Then
Set theChart = myShape.Chart
If theChart.ChartTitle.Text = "This is blue" Then
theChart.ChartTitle.Text = "This is yellow"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 0)
Else
theChart.ChartTitle.Text = "This is blue"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 255)
End If
End If
End Sub
This is not exactly an answer but I think you should name your object.
Instead of using
ActivePresentation.Slides(1).Shapes(1)
You can name the object.
I wrote some code for a client which isn't working correctly on his machine (Win 10, Office 365) but is on mine (Win 10, Office 2016). The code inserts an image to the header then positions it and resizes it. I use the ConvertToShape method so I can access properties like width, height and position of the Shape class.
Dim pic As Shape
Dim shp As Word.InlineShape
Set shp = thisDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(fpImage) ' insert the image to the header
Set pic = shp.ConvertToShape ' THIS LINE CAUSES THE PROBLEM
The method causes the image to disappear. 'Pic' is still available and setting it's properties causes no error, but it is not visible. It's .visible property returns true.
Any ideas? Thanks.
Answer provided to cross-post at Microsoft Community
There is a way to do this with only an inline shape, by setting up a table to position the text on the left and the picture on the right. An additional advantage of this method is that, if you set the table's AutoFitBehavior property to wdAutoFitFixed and set the column width to the width you want for the shape, Word will automatically resize the picture to that width and keep the aspect ratio.
Here's a little sample macro:
Sub x()
Dim fpImage As String
Dim strExistingHeaderText
Dim tbl As Table
Dim shp As InlineShape
fpImage = "D:\Pictures\bunnycakes.jpg"
With ActiveDocument
strExistingHeaderText = _
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text
Set tbl = .Tables.Add( _
Range:=.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
numrows:=1, numcolumns:=2, _
AutoFitBehavior:=wdAutoFitFixed)
tbl.Columns(2).Width = InchesToPoints(1.5)
tbl.Columns(1).Width = InchesToPoints(5#)
tbl.Cell(1, 1).Range.Text = strExistingHeaderText
'tbl.Borders.Enable = False
Set shp = tbl.Cell(1, 2).Range.InlineShapes.AddPicture(fpImage)
End With
End Sub
the title pretty much says it all, but to make it a little more clear, say I want to create a text box via VBA that says "This text should be of font size 24, this text should be of font size 20."
Right now, I'm using my own function to create the text box, which is below. Cheers, and thanks for the help!
Sub textBox(textBoxText As String)
Dim myTextBox As Shape
With ActiveWindow.Selection.SlideRange
Set myTextBox = .Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, Left:=153, Top:=50, _
Width:=400, Height:=100)
myTextBox.TextFrame.TextRange.Text = textBoxText
myTextBox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
myTextBox.TextFrame.TextRange.Font.Bold = msoTrue
myTextBox.TextFrame.TextRange.Font.Name = "Arial (Headings)"
End With
End Sub
A RichTextBox is not needed. The answer lies in the properties of the TextRange object within the TextFrame of the TextBox (what a mouthful!). Basically, you can parse/traverse the text within this range object and, if you make selections based on paragraphs (or sentences, words, characters, etc) you can apply different text effects.
Sub CreateTextbox()
Dim MyTextBox As Shape
Dim textBoxText As String
Dim textToChange As TextRange
textBoxText = "this is some wild text"
With ActiveWindow.Selection.SlideRange
Set MyTextBox = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=153, Top:=50, Width:=400, Height:=100)
MyTextBox.TextFrame.TextRange.Text = textBoxText
MyTextBox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
MyTextBox.TextFrame.TextRange.Font.Bold = msoTrue
MyTextBox.TextFrame.TextRange.Font.Name = "Arial (Headings)"
# here's where the magic happens
Set textToChange = MyTextBox.TextFrame.TextRange
textToChange.Words(3).Select
textToChange.Words(3).Font.Size = 42
End With
End Sub
Get the text range reference and then assign the desired font size.
With myTextBox.TextFrame2.TextRange
With .InsertAfter("This text should be of font size 24,")
.Font.Size = 24
End With
With .InsertAfter("this text should be of font size 20")
.Font.Size = 20
End With
End With
I have been working on a small hack around with Power Point to automatically create a Text Box Shape with some preset effect in which the text is dynamically fetched from clipboard. I have quiet a bit of a problem here, the functionality works fine with the following VB script with macros.
Sub ReadFromFile()
' CLIPBOARD
Dim MyData As DataObject
Dim strClip As String
' CLIPBOARD
Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
Set activeDocument = ActivePresentation.Slides(1)
With activeDocument
'Set QASlide = .Slides.Add(Index:=.Slides.Count + 0, Layout:=ppLayoutBlank)
activeDocument.Shapes.AddTextEffect PresetTextEffect:=msoTextEffect28, _
Text:=strClip, _
FontName:="Garde Gothic", FontSize:=44, FontBold:=msoTrue, _
FontItalic:=msoFalse, Left:=25, Top:=25
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
End With
End Sub
Can some one help me in providing the script for wrapping the text inside the shape which has a defined width and height as in the code above?
Not sure if I understand you right but does adding .TextFrame.WordWrap = msoTrue to the block below solve your problem?
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
I think you are looking for this:
.Shapes(.Shapes.Count).TextFrame.TextRange.Text = strClip
You can set it in the same With that you are setting the height and width
If you want text to wrap within a shape, you'll have to use something other than a texteffect shape.