I'm automatically generating a powerpoint slide through VBA, User Forms, and Excel. You run the VBA script in excel, fill out the data, the data goes into cells in excel, then the VBA script pulls the data and puts it into textbox shapes in the slide.
My problem is I want to use different font sizes at different times, so for example 28 pt font for one part and 14 pt for the rest. The problem is that any property changes I make to the textbox applies to all of the text within the shape.
My current workaround is sloppy and is to just generate another textbox over the original and insert spacing in the original so it looks like the larger text is "in" the textbox while it's actually just sitting over a few empty lines set aside.
You can format specific substrings within a string, but it's very cumbersome, for example assuming shp is an object variable representing your textbox:
Sub foo()
Dim shp As Shape
Set shp = ActivePresentation.Slides(1).Shapes("TextBox 3")
shp.TextFrame.TextRange.Text = "Hello, world!"
shp.TextFrame.TextRange.Characters.Font.Size = 14 'applies uniform font to entire shape
shp.TextFrame.TextRange.Characters(1, 5).Characters.Font.Size = 28
End Sub
Example output:
The difficulty of course is working with mixed formats, and I do not think there is any easy solution. It will be up to you to determine what formats you need to "capture", and what subsequently implement the appropriate conditional logic to transfer those formats to the PowerPoint shapes.
One possible alternative -- and this is the route that I would go if I were you -- would be to copy the cell from Excel, and use this method to paste in to PowerPoint. I believe this will create a table consisting of a single cell, in the PowerPoint slide. You will have to make adjustments for size/position, but this should be an order of magnitude easier than trying to capture every possible variation of font formatting:
Sub foo2()
Dim shp As Shape
Dim xl As Object
'Get Excel and copy a specific cell
Set xl = GetObject(, "Excel.Application")
xl.Workbooks("Book35").Sheets("Sheet2").Range("B4").Copy
'Paste that cell in to PowerPoint as a table, preserving formats:
ActivePresentation.Slides(1).Select
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
End Sub
Example output, as copied from the Excel cell:
No need to change the font in excel to reflect in Word. You can do it directly. Just paste the below mentinoed line in Word VBA : -
Activedocument.Shapes("sam").TextFrame.TextRange.Words(1).Font.Size = 28
Related
I have an excel file which contains 1000+ pictures. The pictures are embeded in Column J of each row.
I have a userform which allows user to update a picture. What I want is to delete the picture that is present in the cell before updating a new picture.
The code that I found and tried to use:
Dim curPic As Shape
For Each curPic In Worksheets("Sheet1").Shapes
If Not Application.Intersect(curPic.TopLeftCell, PicCell) Is Nothing Then
curPic.Delete
End If
Next curPic
The thing is since I have a 1000+ pic, it checks each and every picture and I get a "Not Responding" on the file.
Is there a way to search only in a particular cell since I know the cell location.
Assumption: the top left corner of the shape is within the particular cell.
This routine takes the cell you want to check - and then compares the topLeftCell-Address of each shape against the address of your cell.
If they match, shape will be deleted.
What is different to your code: I am comparing the addresses of the ranges and am not intersecting ranges. I suppose this will be faster but haven't tested it.
Furthermore the for-next-loop is exited as soon as the shape has been found. That means the routine will be faster for the first cells in your column but slower for the last cells.
Option Explicit
Sub deleteShapeInRange(rgCell As Range)
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.TopLeftCell.Address = rgCell.Address Then
shp.Delete
exit for
End If
Next
End Sub
I'm working on creating a PowerPoint template for daily class presentations. In the template I'd like to have a hunk of text that is prominently displayed on the first slide and which repeats at the bottom of the subsequent slides at the bottom in a smaller size. The text will change every day.
The ideas I've had so far:
Use a text field. As far as I can tell, PowerPoint doesn't have anything like a text field that can be dynamically set.
Use a footer - this works and I can modify the master to get the look I want, but I'd really like to be picking up the value of the text from the first page so that edits would be automatically applied and to save the initial step of setting the footer.
Using VBA - I'd be willing to give this a shot, but I've never used VBA and the learning curve seems steep so it would be nice to know if the idea is feasible in VBA.
Can this be done? How would you approach it?
Here's an example of what I'm hoping to be able to do. Ideally the solution would work on both the Mac (2013) and Windows (2016) version of PowerPoint.
You can connect your presentation with an excel file. And running the code in the ppt would pull out the text in the excel file and update the titles instantly.
Create a presentation with a textbox with some temporary text. Put the below code in ppt. save as pptm.
Sub AddMotionPath()
Dim Temp As String
Excel.Application.Workbooks.Open ("D:\Users\Desktop\Book1.xlsx") ' update the path of the excel file
Workbooks("Book1.xlsx").Activate 'activate the file
For p = 1 To 4
Temp = Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("B" & p + 1).Value ' Column B has the titles
ActivePresentation.Slides(p).Shapes(1).TextFrame.TextRange.Text = Temp ' this updates the titles from excel to ppt slide
Next
Excel.Application.Workbooks("Book1.xlsx").Close False 'closes the excel file
End Sub
Let me know if this works for you. You can update the excel file and run the macro in ppt. The text in the slides will be updated automatically.
I have made a large diagram of made by shapes with numbers stored inside as text and need to change the "old" numbers to a "new" range of numbers. On each of the 20 sheets there are circles, Rectangles, Left Arrows and Right Arrows. The old range of numbers are stored on a separate spreadsheet in the Column "A" and need to be changed to the numbers listed in Column "B" (as in A1 to B1).
What would a VBA method to change the old text inside the Shapes to the new correct text based off of a new range of numbers? Is it possible to write a script that changes the values in the entire WorkBook?
My incorrect way of thinking is to:
1. Search inside the diagram to find the various shapes.
2. Get the text inside each shape.
3. Compare the text with the spreadsheet with the old numbers.
4. Insert the new number.
5. Move onto the next shape.
Put a value in A1 and say we already have a Shape:
Running this:
Sub LinkCellToShape()
Dim sh As Shape
Set sh = ActiveSheet.Shapes(1)
sh.DrawingObject.Formula = "=A1"
End Sub
will link the text in the shape to the value in the cell. You could also use:
sh.OLEFormat.Object.formula = "=A1"
I need to know is selected shape word art or not.
Shape has property "Type" (returns enum MsoShapeType).
When I insert word art and check this property - it returns msoAutoShape instead of msoTextEffect (with AutoShapeType==msoShapeRectangle).
How can I check that spae is word art (not usual rectangle with textbox) ?
Thanks!
If you select either the overall smartart shape or click into text within the smartart shape or select one of the shapes within the smart art, ActiveWindow.Selection.ShapeRange(1) will return the smartart shape.
So
If ActiveWindow.Selection.ShapeRange(1).HasSmartArt Then
Debug.Print "It's smart art"
End if
[edited]
But as you've pointed out, this is for smartart, not word art. My error, sorry.
There isn't a WordArt shape as such; it's more like any shape that has had WordArt formatting applied to the shape as a whole or to text within the shape. That'd include formatting like glow, reflection, shadow and so on, or could be one of the WordArt presets, pre-selected combinations of these different effects. I've added an example that'll help identify shapes or ranges of text within shape that have these presets applied. I don't see any simple way of checking for user-applied WordArt formats other than looking at each run and each text box for each of the various properties (glow, reflection etc) that might be applied. Unfortunately, there's no WordArtFormat = None to tell us we can ignore it. It's either going to be one of the presets or -2, which can mean any of several things.
Sub WordArtist()
Dim oSh As Shape
Dim oRng As TextRange2
' Has word art formatting been applied to
' entire shape?
Set oSh = ActiveWindow.Selection.ShapeRange(1)
Debug.Print oSh.TextFrame2.WordArtFormat
' Has it been applied to individual chunks of
' text within the shape
For Each oRng In oSh.TextFrame2.TextRange.Runs
Debug.Print oRng.Font.WordArtFormat
Next
' Note:
' A result of -2 for the entire shape could mean
' - No text in the shape; not really word art
' - Mixed formatting
' - Text/shape has had glow/shadow/reflection etc applied
' rather than one of the preset WordArt selections
End Sub
I have a Visio drawing and I want to be able to Select shapes from it and paste them to other sheets depending on certain variables.
What is the code for selecting the different shapes on the page. I am trying this but it is not working.
Dim vsoSelection As Visio.Selection
vsoSelection.Select Visio.Shape(1), visSelect
What am I missing here?
and also is it possible to get the strings entered into text boxes into Visio?
I am assuming you're getting an error because your vsoSelection object is nothing. So you need to do:
Set vsoSelection = ActiveWindow.Selection