I've been trying to create a macro that converts all the numbers in a text box, on a slide, to superscript but I'm finding Powerpoint VBA to be very strange.
I've tried this short line of code as a starter, but this doesn't seem to select properly.
ActivePresentation.Slides(1).Select.Font.superscript = True
Any help would be much appreciated.
Thank you!
First off, never select anything unless you absolutely must (rare, very rare).
Next, you've selected a Slide object. Slides don't have any font properties, so you can't SET them.
Here's an example that sets all of the characters in the currently selected shape to superscript. You'll likely want to refine it to iterate through all the shapes in the slide, and to skip any characters that aren't numbers.
[Edited to Super rather than Sub-script characters and ONLY numeric characters]
Sub SuperscriptMe()
Dim oSh As Shape
Dim x As Long
Set oSh = ActiveWindow.Selection.ShapeRange(1)
With oSh.TextFrame.TextRange
For x = 1 To .Characters.Count
' verify that the character is a number
If IsNumeric(.Characters(x)) then
.Characters(x).Font.Superscript = True
End If
Next
End With
End Sub
Related
I'm trying to record a macro that will set the size of a pasted image to 6.5 x 4 cms and the image layout 'in front of text'. I usually set this by right clicking on the image and setting the picture properties but this isn't available when recording the macro. Using Shift-F10 does bring up the menu, but the option to set the image layout properties is greyed out.
Please help!
Thanks
Yes, that's interesting about the macro recorder...
If you need to do something like this in the future it will help you to know that an object with any kind of "text wrap" formatting (that "floats") is a Shape. An object that behaves like a character is an InlineShape. And you can convert between the two using ConvertToInlineShape / ConvertToShape. For future things of this nature that should give you a starting point :-)
The following code sample uses ConvertToShape so that text wrap formatting can be applied. (The conversion is an extra step involved that you don't have to do in the UI - Word does it for you.)
Before this happens the code changes the size, but it could also be the other way around, changing the size on the Shape object.
What else is happening in the code: When a picture is pasted inline it's not selected. So this code figures out how many pictures (InlineShapes) are already in the document up to the selection. After the paste the code then picks up the existing number of pictures up to that point, plus one, to get the picture that was just pasted.
The code uses CentimetersToPoints to convert the number of centimeters wanted to the Points measurement, since that's what Word uses to size graphical objects (and lots of other things).
How did I know to use wdWrapFront: When shp.WrapFormat.Type = is typed the VBA Editor will automatically show a list of valid entries for text wrap formatting. Similarly, when shp. is typed a list of valid properties for a Shape will appear, and so on. (This is called IntelliSense and is a wonderful help!)
Sub PasteAndSelectPicture()
Dim ils As Word.InlineShape
Dim shp As Word.Shape
Dim lNrIls As Long
Dim rngDoc As Word.Range
Dim rngSel As Word.Range
Set rngDoc = ActiveDocument.content
Set rngSel = Selection.Range
rngDoc.End = rngSel.End + 1
lNrIls = rngDoc.InlineShapes.Count
rngSel.Paste
' Debug.Print rngDoc.InlineShapes.Count, lNrIls
Set ils = rngDoc.InlineShapes(lNrIls + 1)
ils.width = CentimetersToPoints(6.5)
ils.height = CentimetersToPoints(4)
Set shp = ils.ConvertToShape
shp.WrapFormat.Type = wdWrapFront
End SUb
I have this code to put a border on all images in my Word document. Inline shapes as floating shapes. Works fine. All images have a border. But my images on the first page (like Logo) also have a border.
Can anyone help me out with code for deleting the borders around floating images on the front page? Or specific shapes?
Thank you.
Kem
The Selection.Information(wdActivePageEnd) command can give you the current page number and in your case all you need to do is set the current selection point or working range to the top of the document ... and now you know you are on page 1.
The second challenge is selecting or setting a working range to only the first page. I use the built-in Bookmark "\Page".
The third challenge is identifying the type of shape and for that you use the Shape.Type property. If you are going after images remember they could be embedded or linked so you have to use the two property types.
Finally, in your questions you are asking how to remove borders. Well IMO you don't have to remove them, you only hide them.
Here is example code that you can study and figure out how to integrate with your existing code.
Sub RemoveBorders()
Dim rng As Word.Range, shp As Word.Shape
Set rng = ActiveDocument.Content
rng.Collapse Word.WdCollapseDirection.wdCollapseStart
Set rng = ActiveDocument.Bookmarks("\Page").Range
For Each shp In rng.ShapeRange
If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
shp.Line.Visible = False
End If
Next
End Sub
I am new to VBA so I am struggling with what seems to be quite a simple task.
I have a few lines of text in each cell in a word document. Each cell contains a category such "Science" or "Health" or one of several others. At the minute I'm actually just using a special character such as "*" or "#" for testing purposes.
I need the text colour of all text in the cell to change depending on which category is in the cell. So the txt would be e.g. green for "Science" and red for "Health".
It seems that running a macro is quickest way of making these changes (there will be over 200 such cells in my final document and colouring manually is such a waste of time). Basically, I'm struggling with first changing the colour of all the text in the cell, and secondly how to make the macro search again if the first criteria is not met. I would like 1 macro that could complete colouring for the entire document, rather than having multiple macros for each colour I need.
If you could give me some examples of VBA I could work with that would be most helpful. I'm really struggling and any help you could give will save me and my team so much time.
This should perform reasonably well unless your document is huge or your keyword list is huge or both.
Sub ColorCells()
Dim tbl As Table
Dim rw As Row
Dim cll As Cell
Dim i As Long
Dim Keywords As Variant, Colors As Variant
'if you have more than one table, you have to look through them
Set tbl = ThisDocument.Tables(1)
'Make two arrays - one with keywords and the second with colors
'where the colors are in the same position in their array as the
'keywords are in theirs
Keywords = Array("Science", "Health")
Colors = Array(wdBlue, wdDarkRed)
'Loop through every row in the table
For Each rw In tbl.Rows
'Loop through every cell in the row
For Each cll In rw.Cells
'Loop through every keyword in your array
For i = LBound(Keywords) To UBound(Keywords)
'if the keyword exist, change the color and stop checking
'further keywords
If InStr(1, cll.Range.Text, Keywords(i)) > 0 Then
cll.Range.Font.ColorIndex = Colors(i)
Exit For
End If
Next i
Next cll
Next rw
End Sub
If you want to use custom colors instead of built in ones, change the Colors array assignment line to
Colors = Array(RGB(192, 192, 192), RGB(188, 25, 67))
and the line where you set the color to
cll.Range.Font.TextColor.RGB = Colors(i)
Background (skip if needed, there to help people Googling the same problem)
When you create text boxes in word (I was using the auto caption on figures), use italicised text and align right, you often find a bit of the last letter can be cut off.
Here's the situation where I noticed it first (zoomed in alot)
Or to accentuate with a more flourishy script:
F is a good letter to recreate this problem with. This is a known bug, and the solution on that page was to add in a non-breaking whitespace (ctrl+shift+space or chrW(160) in VBA)
Problem
I tried to create a macro to add a non breaking space to each textbox in my document, if:
The textbox is right-aligned
The text inside is italicised
There isn't one already
Here's the code I came up with:
Sub captionSpaces() 'placed in normal.dot module
Dim grp As Shape
Dim tb As Shape
Dim txRng As Range
Dim str As String
For Each grp In ActiveDocument.Shapes 'all my textboxes are in groups - I might add handling in case they aren't
For Each tb In grp.GroupItems 'Loop through all shapes in all groups
If tb.Type = msoTextBox Then 'Single out text-boxes
Set txRng = tb.TextFrame.TextRange 'Get text content
If txRng.Italic And txRng.ParagraphFormat.Alignment = wdAlignParagraphRight Then 'only act on this sort of text
str = txRng.Text
If Right(str, 1) <> ChrW(160) Then 'check for a space already present
str = str & ChrW(160) 'create new string...
txRng.Text = str '...and set it (could have done in 1 step)
End If
End If
End If
Next tb
Next grp
End Sub
'NB I appreciate I could have put all my conditions in one IF with AND,
'but I find this clearer and I think it will be marginally quicker
'since you aren't SETting the str over and over
This doesn't work for me and I am not familiar enough with Word VBA to work out why; in all but one of my captions it doesn't do anything, in one of them it seems to add 2 new lines. Very bizarre
Possible avenue; the groups are wrapped in 3 ways; Square, Tight and Top & Bottom, the captions are all beneath the images (and grouped to them). The one that gets the extra lines is the only one wrapped tight.
I have dozens of PowerPoint shows that contain dozens of slides each. They are very basic in that there is only one shape on each slide and there is no animation being used on the shape or between slides. The issue is that the person who created them didn't really pay attention to the vertical position of the shapes from slide to slide so it's very noticeable when going from one slide to the next.
I would like to be able to quickly set the vertical position to the same value for each shape on each slide. The horizontal position is fine. I've been doing them manually but there are a lot of slides and slide shows to go through and I'd rather not have to do this as it is very time consuming.
I've done some searching here on this site as well as on Google but haven't found anything yet. If it requires VBA code, that's fine too.
I am using PowerPoint 2010.
As a starting point (total air code, mind you):
Sub LineEmUpDano()
Dim oSl as Slide
Dim sngTop as Single
' Pick up the top position of the first shape
' on the first slide:
SngTop = ActivePresentation.Slides(1).Shapes(1).Top
' Apply the top position to each slide in the pres
For Each oSl in ActivePresentation.Slides
oSl.Shapes(1).Top = sngTop
' you could instead use
' oSl.Shapes(1).Top = 42 ' or whatever value you like
' Values are in points, 72 points to the inch
Next ' slide
End Sub
Using Steve's suggestion above as a jumping off point and then reading some tutorials I was able to come up with a working script:
Sub UniformHeight()
Dim SlideToCheck As Slide
Dim ShapeIndex As Integer
For Each SlideToCheck In ActivePresentation.Slides
For ShapeIndex = SlideToCheck.Shapes.Count To 1 Step -1
SlideToCheck.Shapes(ShapeIndex).Top = 36
Next
Next
End Sub