Centered Text Box on Each Page in Word - vba

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

Related

Keep Picture Ratio in Word File

I add a picture via VBA in the Left Header Cell of a Word document - works fine with the following code. Now I want to keep the ratio of the Picture but want to change the size and I don't know how to do it:
Sub AutoOpen()
Dim dd1 As Document: Set dd1 = ActiveDocument
Dim rng1 As Range, seC As Section, an(2) As Long
Dim rngO As Range, rngAN As Range
Dim strToPict As String
For Each rngO In dd1.StoryRanges
ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If rngO.StoryType = wdEvenPagesHeaderStory Then
Set rng1 = rngO.Duplicate
For Each seC In rng1.Sections
an(0) = seC.Headers(1).Range.InlineShapes(1).Height
an(1) = seC.Headers(1).Range.InlineShapes(1).Width
Set rngAN = seC.Headers(1).Range.InlineShapes(1).Range.Duplicate
seC.Headers(1).Range.InlineShapes(1).Delete
seC.Headers(1).Range.InlineShapes.AddPicture FileName:=strToPict, _
LinkToFile:=False, SaveWithDocument:=True, Range:=rngAN
With seC.Headers(1).Range.InlineShapes(1)
.Height = 50
.LockAspectRatio = True
End With
Next
Dim i As Long
ActiveDocument.Save
'Footer changing'
For i = 1 To ActiveDocument.Sections.Count
With ActiveDocument.Sections(i)
.Footers(wdHeaderFooterPrimary).Range.Text = ActiveDocument.Name + "Text"
End With
Next
End If
Next
End Sub
EDIT: I post the whole code of the Makro.
«I add a picture via VBA in the Left Header Cell of a Word document». There is no such thing as a 'Left Header Cell' in a Word document. The only headers (and footers) Word has are Primary, First Page and Even Pages.
And, as Timothy said, you "really need to learn to use the tools at you fingertips". Moreover, having found LockAspectRatio, a simple web search - if that was really necessary - would show you how to use it.
In any event, since all it seems you're trying to do is to resize the inlineshape and repeat the primary page header, you could use something along the lines of:
Sub AutoOpen()
Application.ScreenUpdating = False
Dim Rng As Range, iShp As InlineShape, Sctn As Section, StrNm As String
With Dialogs(wdDialogInsertPicture)
.Display
StrNm = .Name
End With
With ActiveDocument
If StrNm <> "" Then
Set Rng = .Sections.First.Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range
Set iShp = .InlineShapes.AddPicture(FileName:=StrNm, _
LinkToFile:=False, SaveWithDocument:=True, Range:=Rng)
With iShp
.LockAspectRatio = True
.Height = 50
End With
End If
Set Rng = .Sections.First.Footers(wdHeaderFooterPrimary).Range
.Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="FILENAME", PreserveFormatting:=False
Rng.InsertAfter vbTab & "Text"
For Each Sctn In .Sections
Sctn.Headers(wdHeaderFooterPrimary).LinkToPrevious = True
Sctn.Footers(wdHeaderFooterPrimary).LinkToPrevious = True
Next
End With
Application.ScreenUpdating = True
End Sub
You really need to learn to use the tools at you fingertips - IntelliSense, the Object Browser, and online help.
Scrolling through the options that IntelliSense gives you, or looking up InlineShape in the Object Browser, you would find LockAspectRatio. If you weren’t sure whether that was what you needed, pressing F1 would take you to the online help.

Word footer image alignment in VBA

I try to put a signature in the footer of a word document, but I can't align it at the bottom right of the footer.
Also, in my footer there is a line of text (i.e. my Company Inc) and the signature must be exactly over the text, as in the screenshot:
Any help, please?
My code, which works except for the positioning:
Sub Macro1()
Dim SHP as String
FIRMADOC = "C:\Users\user\Pictures\1.png"
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Set SHP = Selection.InlineShapes.AddPicture(FileName:=FIRMADOC, LinkToFile:=False, SaveWithDocument:=True)
With SHP
'AJUSTA A "ENFRENTE DEL TEXTO"
.ConvertToShape
' MANTIENE EL RATIO
.LockAspectRatio = msoTrue
'AJUSTA A ANCHO 1 inch
.Width = InchesToPoints(1)
' .Alignment = ' need this code for bottom-right, PLEASE
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End sub
Because Shape objects "float" on the page, they can be easily positioned. They can also be easily (and accidentally) repositioned. Shape objects can also be tricky to hanlde using code. So a useful rule-of-thumb I use is: if an InlineShape works, use it rather than a Shape.
Three possibilities are out-lined, below; two for InlineShapes and one for a Shape.
An InlineShape can be positioned right-aligned to the page using two different methods (depending on whether it's alone in the paragraph).
Right-align the paragraph which contains the InlineShape. This is appropriate when the paragraph has no other content. Extracting just the code from the question for handling this:
Dim SHP as InlineShape
Set SHP = Selection.InlineShapes.AddPicture(FileName:=FIRMADOC, _
LinkToFile:=False, SaveWithDocument:=True)
SHP.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
If the paragraph has other content to the left, then a right-aligned TAB stop with a TAB character preceding the InlineShape will work. A Footer by default has two TAB stops: one center-aligned, the second right-aligned.
For this, I'm going to change the entire code in the question in order to optimize working in a Footer. (The same approach applies to a Header BTW). The macro recorder produces code that emulates user actions, so it actually opens up the footer (or header) using things like ActiveWindow and Selection. These are somewhat difficult to control precisely; working with the actual Word objects is more reliable.
Think of a Range object like an invisible selection. The entire Footer area is assigned to a range (rng). Since the Footer already has content (the "Company Inc" text), it's necessary to "collapse" the Range. (Think of it like pressing left-arrow so that new content does not replace a selection.)
Then two TAB characters are added to it (rng.Text = vbTab & vbTab) and the signature is added.
Sub Macro1()
Dim FIRMADOC as String
Dim SHP as InlineShape
Dim rng as Word.Range
FIRMADOC = "C:\Users\user\Pictures\1.png"
Set rng = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
rng.Collapse wdCollapseStart
rng.Text = vbTab & vbTab 'position at second, right-aligned tab in the footer)
Set SHP = rng.InlineShapes.AddPicture(FileName:=FIRMADOC, LinkToFile:=False, SaveWithDocument:=True, Range:=rng)
With SHP
' MANTIENE EL RATIO
.LockAspectRatio = msoTrue
'AJUSTA A ANCHO 1 inch
.Width = InchesToPoints(1)
End With
End sub
If it's necessary to use a Shape object, then a combination of the Left and RelativeHorizontalPosition properties is required. Members of the wdShapePosition and WdRelativeHorizontalPosition enumerations specify these special settings.
Note that it also might be necessary to include the Top property to get the correct vertical position of the Shape to the "Company, Inc" text.
Sub Macro1()
Dim FIRMADOC as String
Dim SHP as InlineShape
Dim rng as Word.Range
FIRMADOC = "C:\Users\user\Pictures\1.png"
Set rng = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
rng.Collapse wdCollapseStart
Set SHP = rng.InlineShapes.AddPicture(FileName:=FIRMADOC, LinkToFile:=False, SaveWithDocument:=True, Range:=rng)
Set SHP = SHP.ConvertToShape
With SHP
' MANTIENE EL RATIO
.LockAspectRatio = msoTrue
'AJUSTA A ANCHO 1 inch
.Width = InchesToPoints(1)
.Left = wdShapeRight '-999996
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin '0
End With
End sub

How to to place a picture/logo in a header with and without content already in it?

I currently work for a recruiting firm and I'm trying to write a program that will post my company's Logo on the Top Left Corner of a resume.
Some resumes have content in the header, some don't. I made two if's statements to address both circumstances, but for some odd reason, it does not seem to work.
This is my code below:
Dim i As Long
Dim FooterText As String
Dim Logo As Shape
Dim HeaderExists As Section
'Header:
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Set HeaderExists = ActiveDocument.Sections(1)
Set Logo = Selection.InlineShapes.AddPicture(FileName:="My company logo", _
LinkToFile:=False, SaveWithDocument:=True).ConvertToShape
If HeaderExists.Headers(wdHeaderFooterFirstPage).Exists = False Then
With Logo
.WrapFormat.Type = wdWrapBehind
.Left = -67
.Top = -30
.Width = 107
.Height = 48
End With
End If
If HeaderExists.Headers(wdHeaderFooterFirstPage).Exists = True Then
With Logo
.WrapFormat.Type = wdWrapBehind
.Left = 5
.Top = 5
.Width = 107
.Height = 48
End With
End If
As of right, the code only works for resumes WITH content in the Header. For some reason, when I change wdHeaderFooterPrimary to wdFooterFirstPage, it flips, and only works for resumes WITHOUT content in the Header.
Unless you want to logo to appear on every page, you'll need to apply a 'different first page' layout to documents that don't already have it. Then you'll need to decide what to do with documents that didn't have that layout but had a header, since the existing header will now only appear on the 2nd & subsequent pages (if there is more than one page). In the following code, I've enforced a 'different first page' layout, which obviates any concerns about what happens in your problem scenario, and have assumed the header & logo are only to appear on the first page:
Sub Demo()
Application.ScreenUpdating = False
Dim Sctn As Section, Rng As Range, Shp As Shape
Set Sctn = ActiveDocument.Sections.First
With Sctn
If .PageSetup.DifferentFirstPageHeaderFooter = False Then
'Apply a Different First Page layout
.PageSetup.DifferentFirstPageHeaderFooter = True
Set Rng = .Headers(wdHeaderFooterFirstPage).Range
With Rng
'Replicate the original Primary header
If Sctn.Headers(wdHeaderFooterPrimary).Range.Text <> "" Then
.FormattedText = Sctn.Headers(wdHeaderFooterPrimary).Range.FormattedText
.Characters.Last.Delete
End If
End With
'Delete the original Primary header
Sctn.Headers(wdHeaderFooterPrimary).Range.Text = vbNullString
End If
With Rng
.Collapse wdCollapseStart
'Add the logo
Set Shp = .InlineShapes.AddPicture(FileName:="My company logo", _
LinkToFile:=False, SaveWithDocument:=True).ConvertToShape
'Adjust the logo's formatting
With Shp
.WrapFormat.Type = wdWrapBehind
.Left = 5
.Top = 5
.LockAspectRatio = True
.Width = 107
End With
End With
End With
Application.ScreenUpdating = True
End Sub
If the document has multiple Sections, you'll also need to consider what to do with their page layouts & headers.

How to add a custom Text placeholder in one of the master slides in MS Power Point presentation and access it using VBA Script for each slide?

I have created a custom placeholder namely "CustomHeader" of Text Box Type on one of the slides in my Power Point presentation. How can I iterate through all slides inserting the Presentation Title into this placeholder.
I have the following code, which enters the Page No in a custom format in the footer. It also inserts the Section to the footer of the slides. I would like to enter something in the CustomHeader placeholder to every matching slide.
Sub SecFootNew()
Dim oshp As Shape
Dim b_found As Boolean
If ActivePresentation.SectionProperties.Count > 0 Then
Dim osld As Variant
For iSlide = 1 To ActivePresentation.Slides.Count
' Need Help with These
With ActivePresentation.Slides(2).Shapes.Placeholders(CustomHeader).TextFrame.TextRange
.Text = "Happy Honika"
End With
' The Following portion of the code is working Perfectly
If iSlide <> 1 Then
Set osld = ActivePresentation.Slides(iSlide)
' Configure Display of Page Number
With osld.HeadersFooters.DateAndTime
.Visible = False ' True For making the Date Visible
' .UseFormat = True
' .Format = ppDateTimedMMMyy
End With
' Configure Footer
osld.HeadersFooters.Footer.Visible = True
osld.HeadersFooters.SlideNumber.Visible = True
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderFooter Then
With oshp.TextFrame.TextRange
.Font.Name = "Calibri"
.Font.Size = 12
.Font.Color = RGB(255, 255, 255)
.Text = ActivePresentation.SectionProperties.Name(osld.sectionIndex)
End With
End If
If oshp.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
With oshp.TextFrame.TextRange
.Font.Name = "Calibri"
.Font.Size = 12
.Font.Color = RGB(255, 255, 255)
.Text = "Slide " & CStr(osld.SlideIndex) & " of " & CStr(ActivePresentation.Slides.Count)
End With
End If
End If
Next oshp
End If
Next iSlide
End If
End Sub
As you can't add placeholders to slides I assume you mean that you have added a Text Placeholder to one of the Custom Layouts in the Slide Master and you have renamed that placeholder "CustomHeader".
When a slide based on that layout is added to the presentation your placeholder will no longer be called "CustomHeader". Instead it will be called something like "Text Placeholder 3". So your first task is to find the name PowerPoint gives your placeholder when it is inserted.
Then you can simply include an extra condition within your loop:
if oshp.Name = "Text Placeholder #" then _
oshp.TextFrame.TextRange.Text = "Happy Honika"

Excel to word Align picture

I have a report that is built from Excel and outputs in Word, I also have a picture called "Picture 7". My question is once this is pasted into word from excel is there anyway to center align the picture?
the picture is copied over as part of a range of cells. So I would need to reference the picture in word.
It is centered on the range of cells but does not quite come out center in the word document
Edit: Currently I am trying this
For Each shp In oDoc.Shapes
If Left(shp.Name, 7) = "RN Logo" Then
shp.Left = wdShapeCenter
End If
Next
But this is just putting the picture in the top left, I think because of the table it is pasted with I may need to do an absolute position on it.
Edit 2:I have found a work around but it is just a large If/Else and absolute positioning, snippet below
Sub Update_RN_Logo_Location()
For Each shp In oDoc.Shapes
If Left(shp.Name, 7) = "RN Logo" Then
If Right(shp.Name, 1) = 1 Then
shp.Left = oWord.CentimetersToPoints(2.4)
Else
shp.Left = oWord.CentimetersToPoints(0.75)
End If
ElseIf Left(shp.Name, 4) = "UKAS" Then
If Right(shp.Name, 1) = 1 Then
shp.Left = oWord.CentimetersToPoints(1.25)
ElseIf Right(shp.Name, 1) = 2 Then
shp.Left = oWord.CentimetersToPoints(2.5)
ElseIf Right(shp.Name, 1) = 3 Then
shp.Left = oWord.CentimetersToPoints(0)
ElseIf Right(shp.Name, 1) = 4 Then
shp.Left = oWord.CentimetersToPoints(2.5)
End If
End If
Next
End Sub
Picture of the document with some removed sensitive information
I believe there are two issues here. First, graphics in word have an anchor. When the graphic is pasted, the anchor for it is placed in the table created by Excel's cells. This throws off positioning.
Second, I suggest using the Shape.RelativeHorizontalPosition property, which will allow your Shape.Left property to give you a true center alignment relative to another page element.
In the code below I am positioning the graphic relative to the document's margins, but there are other choices:
Word 2007 WdRelativeHorizontalPosition Enumeration
This enumeration will also work for Word 2010 and 2013.
To assure proper placement of the logo graphic, insert a carriage return at the top of the document prior to pasting in your logo and table (make sure this carriage return has no indents or styles that apply spatial formatting):
Selection.HomeKey Unit:=wdStory
Selection.InsertBefore vbCr
Then paste in the graphic and table and run this code:
For Each shp In oDoc.Shapes
If Left(shp.Name, 7) = "RN Logo" Then
With shp
.Select
Selection.Cut
Selection.HomeKey Unit:=wdStory
Selection.Paste 'places graphic on carriage return before table
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
'.Top = measurement of choice
End With
End If
Next
Have you tried simply center-aligning the default paragraph (or adding a text box) and pasting in the picture? Keep the picture separate from everything else. You may need to set a text run-around as well.
This is slightly-modified recorded Word VBA
Sub Macro1()
ActiveDocument.Paragraphs.Alignment = wdAlignParagraphCenter
ActiveDocument.InlineShapes.AddPicture FileName:= _
"C:\Users\user\Desktop\01.jpg", LinkToFile:=False, _
SaveWithDocument:=True
End Sub
You could just do a "Control+A" select all and then allign everything to center:
Sub Testing()
'Select All:
Selection.WholeStory
'Center Align All:
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
I'd prefer to insert pictures from outside Excel/Word;
You can position them exactly in the paragraph you want:
Sub M_snb()
ActiveDocument.Paragraphs(5).Range.InlineShapes.AddPicture("G:\Excel_.bmp").Range.ParagraphFormat.Alignment = 1
End Sub