I'm working with word, Office 2010 and I have this macro that inserts a text box with the text "ABC".
Sub AddATextBox()
Dim Box As Shape
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=20, Top:=780, Width:=100, Height:=100)
With Box
.TextFrame.TextRange.Text = "ABC"
.Line.Visible = msoFalse
Box.TextFrame.TextRange.Font.Name = "Arial"
Box.TextFrame.TextRange.Font.Size = 6
End With
End Sub
Instead of the text "ABC", I would like this macro to insert into the text box the field "file name". Preferably without the file extension, but if it's complicated then I can live with it.
How can it be done? Thanks
The code below will insert a textbox at the bottom of the page and write the active document's name into it. Note that the shape isn't part of the footer. It is anchored in the main document body.
Sub InsertATextBox()
Dim Box As Shape
Dim Sp() As String
Debug.Print ActiveDocument.Name
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=20, Top:=780, Width:=120, Height:=12)
Sp = Split(ActiveDocument.Name, ".")
ReDim Preserve Sp(UBound(Sp) - 1)
With Box
With .TextFrame.TextRange
.Text = Join(Sp, ".")
.Font.Name = "Arial"
.Font.Size = 6
End With
.Line.Visible = msoFalse
End With
End Sub
Related
This is my first ever question on SO even I come here regularly (I've always find my answer without having to ask until today). I know this question I've already posted but for some reason i doesn't work for me.
I'm trying to get a right click submenu with a list of every numbered items in my word document. The purpose of it is to insert in a click the numbered and the content text of my numbered item in my document.
The problem is I don't know how to affect each .OnAction (to insert the numbered item in my document) and each .Caption (to show the number and content text of my numbered item in my menu) with a different variable (one for each numbered item). There is probably a problem with my quotes but I cannot see any other solution.
My code is the following :
Option Explicit
Sub ControlButtonNumberedItems()
'Parameters for NumberedItems
Dim i As Integer
i = 1
Dim NumberedItems As Integer
NumberedItems = ActiveDocument.CountNumberedItems
'Parameters for CommanBar
Dim MenuButton As CommandBar
Set MenuButton = Application.CommandBars("Text")
Dim SubMenuButton As CommandBarControl
Set SubMenuButton = MenuButton.Controls.Add(Type:=msoControlPopup, Before:=1)
With SubMenuButton
.Caption = "NumberedItems"
.Tag = "My_Tag"
While i <= NumberedItems
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'InsertNumberedItem""i""'"
.FaceId = 38
.Caption = "MyCaption"
End With
i = i + 1
Wend
End With
End Sub
Sub InsertEvidence(i As Integer)
'Insert NumberRelativeContext
Selection.InsertCrossReference ReferenceType:=wdRefTypeNumberedItem, _
ReferenceKind:=wdNumberRelativeContext, _
ReferenceItem:=i, _
InsertAsHyperlink:=True, _
SeparatorString:=" "
Selection.TypeText Text:=" "
'Insert ContentText
Selection.InsertCrossReference ReferenceType:=wdRefTypeNumberedItem, _
ReferenceKind:=wdContentText, _
ReferenceItem:=i, _
InsertAsHyperlink:=True, _
SeparatorString:=" "
'Text form
Selection.Expand Unit:=wdLine
Selection.Font.Bold = wdToggle
Selection.Font.Italic = wdToggle
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.ParagraphFormat.SpaceBefore = 6
End Sub
Sub ResetRightClick()
Application.CommandBars("Text").Reset
End Sub
Thank you in advance for any help. Please let me know if you need any other information.
I didn't know that Word VBA is different from Excel: see the accepted answer here:
VBA Pass arguments with .onAction
This worked for me (just the code needed to show how parameters can be passed):
Sub ControlButtonNumberedItems()
Dim i As Integer
Dim NumberedItems As Integer
'Parameters for CommanBar
Dim MenuButton As CommandBar
Set MenuButton = Application.CommandBars("Text")
Dim SubMenuButton As CommandBarControl
Set SubMenuButton = MenuButton.Controls.Add(Type:=msoControlPopup, Before:=1)
With SubMenuButton
.Caption = "NumberedItems"
.Tag = "My_Tag"
For i = 1 To 5
With .Controls.Add(Type:=msoControlButton)
.OnAction = "InsertNumberedItem"
.FaceId = 38
.Parameter = i
.Caption = "MyCaption " & i
End With
Next i
End With
End Sub
Public Sub InsertNumberedItem()
MsgBox "got " & CommandBars.ActionControl.Parameter
End Sub
Sub ResetRightClick()
Application.CommandBars("Text").Reset
End Sub
I'd like to format a caption created with the Selection.InsertCaption method in a Word document with VBA (centering the text inside the caption, change font size and colour).
My code so far:
For i = 1 To (mInlinShapes.Count) 'looping through my document inlineshapes
If (mInlinShapes(i).Type = wdInlineShapePicture) Then
Set Shp = mInlinShapes(i).ConvertToShape
Shp.Select
With Selection
.InsertCaption Label:=wdCaptionFigure, _
Title:=" a custom title", _
Position:=wdCaptionPositionBelow, _
ExcludeLabel:=0
End With
Shp.ConvertToInlineShape
End If
Next i
I'd rather avoid re-looping through all my captions to apply formatting, if possible. Any idea?
This should do the Job for You:
For i = 1 To (mInlinShapes.Count) 'looping through my document inlineshapes
If (mInlinShapes(i).Type = wdInlineShapePicture) Then
Set Shp = mInlinShapes(i).ConvertToShape
Shp.Select
With Selection
.InsertCaption Label:=wdCaptionFigure, _
Title:=" a custom title", _
Position:=wdCaptionPositionBelow, _
ExcludeLabel:=0
End With
With ActiveDocument.Styles("Caption").Font
.Name = "Times New Roman"
.Size = 18
.ColorIndex = wdBrightGreen
End With
Shp.ConvertToInlineShape
End If
Next i
For more properties Go here: Link
So I am trying to write a code that adds a text box above a table on each page in a word document. This text box is to be centered to align with the table (I have no issues generating a centered table on each page). I have just recently started working in VBA so my knowledge is a little bit lacking. Here is my code so far, it is kind of a mish mash of what I could find online.
Sub TextMaker()
'
' TextMaker Macro
'
'
Dim i As Long, Rng As Range, Shp As Shape
Dim objDoc As Document
Dim objTextBox As Shape
Set objDoc = ActiveDocument
With ActiveDocument
For i = 1 To 5
Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=InchesToPoints(0.1), Top:=InchesToPoints(1.44), Width:=InchesToPoints(7.65), Height:=InchesToPoints(0.29), Anchor:=Rng)
With Shp
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = InchesToPoints(1.44)
With .TextFrame.TextRange
.Text = "Ref. No.: T" & vbCr & "Signature "
Set Rng = .Paragraphs.First.Range
With Rng
.Font.ColorIndex = wdRed
.End = .End - 1
.Collapse wdCollapseEnd
End With
End With
End With
Next
End With
End Sub
The output works for the first two pages but on the 3rd page the alignment of the text box is not centered. I checked the positioning and the text box still says it is centered relative to page even though it is not.
The code works properly as long as the tables are not inserted, but the table generating code, if run after this one, does not put the tables on the same page as text boxes.
This is the 3rd page of my document, where things start to go wrong. The text box should be positioned above the table and centered in line with it.
In order to reproduce the document, create a blank document and run this table generation code:
Sub TableMaker()
For i = 1 To 5
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=6, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Selection.Tables(1).Columns(1).Width = InchesToPoints(1.39)
Selection.Tables(1).Columns(2).Width = InchesToPoints(6.26)
Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
With Selection.Tables(1).Rows
.WrapAroundText = True
.VerticalPosition = InchesToPoints(1.82)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.DistanceTop = InchesToPoints(0)
.DistanceBottom = InchesToPoints(0)
.AllowOverlap = False
End With
'place cursor at end of page
Selection.EndKey Unit:=wdStory
'insert page break
Selection.InsertBreak Type:=wdPageBreak
Next i
End Sub
Or run the text generation code above and then this table generation code. Either way the formatting is not consistent. There will be no other text on these documents but an image will be placed below the tables on each page.
The problem is a combination of factors:
the table having text flow formatting. If I set that to "none" the textbox is centered correctly.
if the anchor range is outside the table, it works
I then tested the following and determined that the problem is because "Layout in cell" is activated (thanks for that screen shot BTW). When I put that in (see below) the text box is centered on the page because it's positioning is now independent of the table.
With Shp
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = InchesToPoints(1.44)
.LayoutInCell = False
I'm trying to make a macro that can change all the text in all the notes of a powerpoint presentation to a specified font and fontsize (given through InputBoxes).
It seems to work but not in all the slides, some slides it just resets the fontsize to something way larger than what was given. anyone know what could go wrong?
Sub FormatNotes()
Dim intSlide As Integer
Dim strNotes As String
Dim nts As TextRange
Dim strFont, intSize
intSize = InputBox("Please enter font size", "fontsize", "12")
strFont = InputBox("Please enter font", "font type", "Calibri")
With ActivePresentation
For intSlide = 1 To .Slides.Count
Set nts = ActivePresentation.Slides(intSlide).NotesPage. _
Shapes.Placeholders(2).TextFrame.TextRange
With nts
If intSize = "" Then intSize = 12
.Paragraphs.Font.Size = intSize
.Paragraphs.Font.Name = strFont
End With
Next intSlide
End With
MsgBox ("FormatNotes uitgevoerd")
End Sub
Seems to work to me. I also tried it after deleting .Paragraphs as you don't need that if you want to set the whole text to the same type face and size. Do you have an example of it not working for investigation?
By the way, did you know that Notes formatting is not shown by default in PowerPoint and has to be turned on in the Outline view?
Original question is why code did not work for all slides. I think it has to do with fact the code used Placeholder(2) as hard value, so the code only works with TextRange in that Placeholder. If the NotesPage has more than one Placeholder, the code will not work for the other Placeholders.
My code shown here uses .HasTextFrame to determine if a Placeholder has text, and only attempts to set font size and type if this is true. (I used debug.print to see how far the code got, you can comment it out.)
Sub FormatNotes()
' Written 2020-08-29 P.Irving for myself
Dim mySlide As Integer, myPlace As Integer
Dim myNotes As String
Const mySize = "11", myFont = "Calibri"
With ActivePresentation ' qualify macro name
Debug.Print "Slide#", "LEN(Notes)", "LEFT(Notes,50)"
For mySlide = 1 To .Slides.Count
myNotes = ""
For myPlace = 1 To ActivePresentation.Slides(mySlide). _
NotesPage.Shapes.Placeholders.Count
' code copied from learn.microsoft.com/en-us/office/_
' vba/api/powerpoint.textrange.font
' this code does not attempt to SET nts
With ActivePresentation.Slides(mySlide). _
NotesPage.Shapes.Placeholders(myPlace)
If .HasTextFrame Then
With .TextFrame.TextRange.Font
.Size = mySize
.Name = myFont
'.Bold = True
'.Color.RGB = RGB(255, 127, 255)
End With
myNotes = myNotes & _
ActivePresentation.Slides(mySlide). _
NotesPage.Shapes.Placeholders(myPlace). _
TextFrame.TextRange
End If ' .HasText
End With
Next myPlace
Debug.Print mySlide, Len(myNotes), Left(myNotes, 50)
Next mySlide
End With
MsgBox "Applied to " & ActivePresentation.Slides.Count & " slides", _
vbOKOnly, "FormatNotes"
End Sub
I need to edit the properties of an image inserted by AddPicture method.
1) I need to adjust the height to 0.5" and the width is variable (lock the aspect ratio).
2) Wrap text = "In Front of Text"
Is this possile with this method? If so how do I add those properties? If not, what other method should I use and how?
Sub replaceWithImage()
Dim imageFullPath As String
Dim FindText As String
imageFullPath = "C:\Logo.jpg"
FindText = "PlaceHolder"
'Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.text = FindText
' Loop until Word can no longer
' find the search string, inserting the specified image at each location
Do While .Execute
Selection.MoveRight
Selection.InlineShapes.AddPicture FileName:=imageFullPath, LinkToFile:=False, SaveWithDocument:=True
Loop
End With
End With
End Sub
I would do what you need in the following steps:
instead of this line:
Selection.InlineShapes.AddPicture FileName:=imageFullPath, _
LinkToFile:=False, SaveWithDocument:=True
I would do the same but using Object Variable:
'a) create new shape as object variable
Dim SHP 'As InlineShape/As Shape
Set SHP = Selection.InlineShapes.AddPicture(FileName:=imageFullPath, _
LinkToFile:=False, _
SaveWithDocument:=True)
'b) changes made according to SHP varialbe:
With SHP
'this will convert to 'in front of text'
.ConvertToShape
'this will keep ratio
.LockAspectRatio = msoTrue
'this will adjust width to 0.5 inch
.Width = InchesToPoints(0.5)
End With