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
Related
This is my first time writing macro in VBA. My goal is to write a VBA macro that will automatically align (distribute) all images in a Word document horizontally (next to each other) with a small margin on each side of every image. If there is not enough space to fit another image, I need it to go to the next row(just below previous images) and continue with the horizontal alignment of images.
I have searched a lot on the internet, but I haven't found a way to achieve this...
NOTE: My macro already contains code for making all images have the same height(while keeping the same aspect ratio), so I think dimensions shouldn't be a problem...
Here is a small example of what I want to achieve:
I tried using code for Horizontal alignment from this link: https://www.excelcampus.com/vba/align-space-distribute-shapes/
But I got the following result:
Margins are weird and shapes are aligned infinitely instead of going into the next row...
My Code:
Dim lCnt As Long
Dim dTop As Double
Dim dLeft As Double
Dim dWidth As Double
Const dSPACE As Double = 8 'Set space between shapes in points
lCnt = 1
Dim image As Shape
If ActiveDocument.Shapes.Count > 0 Then
For Each image In ActiveDocument.Shapes
With image
.WrapFormat.Type = wdWrapSquare
.LockAspectRatio = msoTrue
.Height = InchesToPoints(3)
If lCnt > 1 Then
.Top = dTop
.Left = dLeft + dWidth + dSPACE
End If
dTop = .Top
dLeft = .Left
dWidth = .Width
End With
lCnt = lCnt + 1
Next
End If
End Sub
Thanks in advance!
Inserting your images into a table with fixed cell dimensions won't achieve what you say you want, since the images clearly don't have the same aspect ratio. What you need to do is to convert them to inlineshapes so that Word can handle the line wrapping. For example:
Sub Demo()
Application.ScreenUpdating = False
Dim iShp As InlineShape
With ActiveDocument
Do While .Shapes.Count > 0
.Shapes(1).ConvertToInlineShape
Loop
For Each iShp In .InlineShapes
With iShp
.LockAspectRatio = True
.Height = InchesToPoints(3)
If .Range.Characters.Last.Next <> " " Then .Range.InsertAfter " "
End With
Next
End With
Application.ScreenUpdating = True
End Sub
You can adjust the vertical spacing between the images by changing the paragraph line spacing. Note too, that the horizontal alignment can be played around with by switching between left, centered and justified paragraph formats.
Since you are new to VBA I wanted to share a bit of code if you were to pursue a Table approach. The code below creates a single-row table that is fixed in width and will not expand width-wise unless you alter the individual cells. For demo purposes only, I insert the same picture into each cell to demonstrate that the image resizes automatically based on cell width.
Sub TableOfPictures()
Dim doc As Word.Document, rng As Word.Range
Dim Tbl As Word.Table, C As Long
Set doc = ActiveDocument
Set rng = Selection.Range
Set Tbl = rng.Tables.Add(rng, 1, 2, Word.WdDefaultTableBehavior.wdWord8TableBehavior)
Tbl.rows(1).Cells(1).Width = InchesToPoints(2)
Tbl.rows(1).Cells(2).Width = InchesToPoints(4.5)
For C = 1 To 2
Tbl.rows(1).Cells(C).Range.InlineShapes.AddPicture ("Y:\Pictures\Mk45 Gun Proj_Blast.jpg")
Next
End Sub
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
I have some code that will put an image onto a document. If there is already a table in the footer, the image appears in the wrong place.
If I manually change the vertical position from 0.44 below 'paragraph' to below 'bottom margin', then it goes to the correct position for all documents.
I can't see any way to access this option in vba however.
Sub myFooter()
' Paste a logo into the footer.
'CTRL+SHIFT+F
Application.ScreenUpdating = False
Dim img As String, shp As Shape, oWD As Word.Document, Sctn As Section
On Error Resume Next
img = "G:\Shared Drives\footer.jpg"
Set oWD = ActiveDocument
For Each Sctn In oWD.Sections
With oWD.Sections(Sctn.Index).Footers(wdHeaderFooterPrimary).Shapes.AddPicture(img)
' for absolute positioning
.Left = CentimetersToPoints(15.75)
.Top = CentimetersToPoints(0.44)
'.below = BottomMargin
End With
Next Sctn
Set shp = Nothing
Application.ScreenUpdating = True
End Sub
Is there some other way to do this, or have I missed something for how to amend the absolute position of the image?
Amend your With section as follows:
With oWD.Sections(Sctn.Index).Footers(wdHeaderFooterPrimary).Shapes.AddPicture(img)
' for absolute positioning
.Left = CentimetersToPoints(15.75)
.RelativeVerticalPosition = wdRelativeVerticalPositionBottomMarginArea
.Top = CentimetersToPoints(0.44)
.TopRelative = wdShapePositionRelativeNone
End With
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 currently working on a MS Word report.
To highlight certain sections, it would be great to shade some part of the text as seen in beneath image:
Unfortunately, I'm just able to add the shading for the full line height, as shown in the following image:
Is there a native way inside MS Word to accomplish the shading for just the text height?
Otherwise I'm forced to embed images inside my report as the headings (This is something I do not want for several reasons, e.g. complications in Table of Contents)
There is no direct way to have a shading as you desire, it's always to the full line height and not the cap height. And this also makes sense, when you think about how the shading would look like for letters with a tail (such as uppercase Q or a descender (such as lowercase g).
If you want to add the shading to single lines only you could mimic the desired effect by anchoring a rectangle shape to the paragraph and position it behind the text.
Here is a quick and dirty VBA macro that adds shading using shapes to the selected lines of text. You have to fine-tune the height and vertical offset of the shapes to the font and font size you are using.
Sub AddShading()
Dim rng As Range
Dim startPos As Integer
Dim endPos As Integer
Dim capHeight As Single
capHeight = 8
Dim verticalOffset As Single
verticalOffset = 3
' backup original select
Set rng = Selection.Range.Duplicate
' start undo transaction
Application.UndoRecord.StartCustomRecord "Add Shading"
Do
' select line of text
Selection.Collapse
Selection.Expand wdLine
If Selection.Start < rng.Start Then
Selection.Start = rng.Start
End If
If Selection.End > rng.End Then
Selection.End = rng.End
End If
' get range of current line to be able to retrieve position of line
Dim rngLine As Range
Set rngLine = Selection.Range.Duplicate
' get the left coordinate
Dim left As Single
left = rngLine.Information(wdHorizontalPositionRelativeToPage)
' get the top coordinate and add a vertical adjustment depending on the font used
Dim top As Single
top = rngLine.Information(wdVerticalPositionRelativeToPage) + verticalOffset
' move to the end position of the line
rngLine.Collapse wdCollapseEnd
If rngLine.Information(wdVerticalPositionRelativeToPage) > top Then
rngLine.Move wdCharacter, -1
End If
' calculate width of line
Dim width As Integer
width = rngLine.Information(wdHorizontalPositionRelativeToPage) - left
' add shape behind text
Dim shp As Shape
Set shp = rng.Document.Shapes _
.AddShape(msoShapeRectangle, left, top, width, capHeight, rng)
With shp
' grey shading
.Fill.ForeColor.RGB = RGB(192, 192, 192)
' no outline
.Line.Visible = msoFalse
' the shape should move with the text
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
' position the shape behind the text
.WrapFormat.Type = wdWrapBehind
End With
' continue with next line
Selection.Move wdLine
Loop While Selection.End < rng.End
' restore original selection
rng.Select
Application.UndoRecord.EndCustomRecord
End Sub