I have reused a code from this link: how to remove a border from an inline shape.
My code has additional conditional instruction for specific inlinshapes.
The code looks like this:
Sub Picture_no_Border()
Application.ScreenUpdating = False
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
With iShp
If .Type = wdInlineShapePicture Then
If Len(.Range.Paragraphs(1).Range.Text) = 2 Then
With .Line
.Visible = False
End With
End If
End If
End With
Next
Application.ScreenUpdating = True
End Sub
It works when the number of pictures is small in my document. However, when I have a document with around 150 pictures then MS Word crashes and stops working. Do you have any idea why?
Related
I am trying to insert and resize an image in word 2019 using vba. I have lot of images to insert and using vba will save a lot of time.
The issue is that I can select the image, but the height does not change. I am sure it is something pretty basic that I am doing wrong. The code, which I found online and I have adjusted a little, is below and any advice would be great. Thank you.
Sub insertimage()
On Error Resume Next
' InsertPic Macro
Dim FD As FileDialog
Dim strPictureFile As String
Dim wrdDoc As Word.Document
Dim ishp As Word.InlineShapes
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.Title = "Select the Picture that you wish to insert."
.Filters.Clear
.Filters.Add "Pictures", "*.jpg; *.bmp; *.gif"
.AllowMultiSelect = False
If .Show = -1 Then
strPictureFile = .SelectedItems(1)
Else
MsgBox "You did not select a Picture."
Exit Sub
End If
End With
Set wrdDoc = ActiveDocument
With wrdDoc
If .Bookmarks.Exists("BasketIso1") Then
.InlineShapes.AddPicture FileName:=strPictureFile, LinkToFile:=False, SaveWithDocument:=True, Range:=.Bookmarks("BasketIso1").Range
.InlineShapes(1).LockAspectRatio = True
.InlineShapes(1).Height = InchesToPoints(1.78)
End If
End With
End Sub
`
You seem to see the picture being inserted, which suggests that the code up to and including .AddPicture works OK.
But then you are referencing the first picture in the document via .InlineShapes(1) (i.e. that does not reference the first picture in the bookmarks range). If it isn't actually the first picture, another picture will be resized (and you may not notice if it is already set to that size.
So you could redefine the type of ishp, which you don't seem to use at present, using
Dim ishp As Word.InlineShape
then use
Set ishp = .InlineShapes.AddPicture(FileName:=strPictureFile, LinkToFile:=False, SaveWithDocument:=True, Range:=.Bookmarks("BasketIso1").Range)
ishp.LockAspectRatio = True
ishp.Height = InchesToPoints(1.78)
Set ishp = Nothing
or a variation on that, e.g.
Set ishp = .InlineShapes.AddPicture(FileName:=strPictureFile, LinkToFile:=False, SaveWithDocument:=True, Range:=.Bookmarks("BasketIso1").Range)
With ishp
.LockAspectRatio = True
.Height = InchesToPoints(1.78)
End With
Set ishp = Nothing
or the
With .InlineShapes.AddPicture(FileName:=strPictureFile, LinkToFile:=False, SaveWithDocument:=True, Range:=.Bookmarks("BasketIso1").Range)
.LockAspectRatio = True
.Height = InchesToPoints(1.78)
End With
NB, probably not a problem in this case but using a generic
On Error Resume Next
when debugging can make it harder to see the cause of an error.
I would like to use VBA to change the width of the images on-by-one in the doc. I need to manually judge wether the current image should be changed or not with a yes-or-no message box when looping through.
The current code is listed below, it works, but the problem is that WORD does not indicate which image is the current one.
Thanks!
Sub change_images()
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
With iShp
If .Type = wdInlineShapePicture Then
iShp.Select
CarryOn = MsgBox("Change current image?", vbYesNo, "")
If CarryOn = vbYes Then
.LockAspectRatio = msoTrue
.Width = 28.345 * 12
End If
End If
End With
Next
End Sub
I tried to add a .Select before the MsgBox line, but the usually selection mark can not be viewed when the code is running.
iShp.Select
Application.ScreenRefresh
You can be solved by using ScreenRefresh method.
I need some help regarding the Shapes Layout in Word Format. I have a word template that has some shapes in it, I want the result when the user tries to print the file or save it in PDF, it should not include the shape borders in it.
My Word File: Download Here
Desired File: Download Here
Actual File - While Editing The Document
While Printing CTRL+P (Desired Result)
I have found a script online that removes the shapes completely, I only want to remove the borders and retain the text/images inside the shape.
The script is as follows:
Sub PrintNoImagesOrShapesInDoc()
Dim objDoc As Document
Dim objInLineShape As InlineShape
Dim objShape As Shape
' Initialization
Set objDoc = ActiveDocument
' Find all images and shapes in the active document and then hide them to prevent from being
printed.
With objDoc
For Each objInLineShape In .InlineShapes
objInLineShape.Select
Selection.Font.Hidden = False
Next objInLineShape
Options.PrintDrawingObjects = False
End With
Dialogs(wdDialogFilePrint).Show
With objDoc
For Each objInLineShape In .InlineShapes
objInLineShape.Select
Selection.Font.Hidden = False
Next objInLineShape
End With
End Sub
Any Positive Help will be appreciated
Thanks,
For example, to save as a PDF:
Sub Demo()
Application.ScreenUpdating = False
Dim objUndo As UndoRecord, Shp As Shape
Set objUndo = Application.UndoRecord
With ActiveDocument
objUndo.StartCustomRecord ("RecordName")
For Each Shp In .Shapes
Shp.Line.Visible = False
Next
.SaveAs FileName:=Split(.FullName, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
objUndo.EndCustomRecord
.Undo
End With
Application.ScreenUpdating = True
End Sub
Context
I have a Word with multiple embedded Excel tables. These Excel tables vary in width. I try to adjust the Excel spreadsheet widths with VBA code so that they are optimized for the page width of my Word document.
The Excels have been embedded via Insert > Object > Microsoft Excel Worksheet
Problems
In the code example, the properties .ScaleWidth and .ScaleHeight have no effect on the size of the tables in Word.
If I change the heights and widths with .Width and .Height the tables refresh back to their original sizes
Code Example 1
For Each oShape In ActiveDocument.InlineShapes
If oShape.Type = wdInlineShapeEmbeddedOLEObject Then
If Left(oShape.OLEFormat.ProgID, 5) = "Excel" Then
oShape.OLEFormat.Activate
oShape.OLEFormat.Object.Application.Worksheets(1).Activate
oShape.ScaleWidth = x ' something calculated
oShape.ScaleHeight = y ' something calculated
End If
End If
Next oShape
It's not clear from your post whether the worksheets are embedded (perhaps with external referencing for which you might use code to update) or as linked objects. Your "I use Inline Shapes instead of linked Excels" doesn't exactly make this any clearer. For the resizing, try:
Sub Demo()
Application.ScreenUpdating = False
Dim Sctn As Section, iShp As InlineShape, sWdth As Single, sHght As Single
For Each Sctn In ActiveDocument.Sections
With Sctn
With .PageSetup
sWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
sHght = .PageHeight - .TopMargin - .BottomMargin
End With
For Each iShp In .Range.InlineShapes
With iShp
.LockAspectRatio = True
If .Width > sWdth Then .Width = sWdth
If .Height > sHght Then .Height = sHght
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub
The above macro will scale down and over-size inline shapes to fit the print area.
As for your "In some tables the last columns from Excel are not visible in Word" issue, the solution really depends on whether the worksheets are embedded or linked.
I am working in VBA on Word 2010.
I have some code to add borders to an inlineshape which is working ok, but I need to be able to remove the border and that doesn't seem to be working. I've searched through this site and can't find anything close apart from this:
Mimic word borders and shading option "apply to:" (text) with vba on an inline shape
Code is a follows:
Sub TestAddBorders()
Dim rngShape As InlineShape
For Each rngShape In ActiveDocument.InlineShapes
With rngShape.Range.Borders
.OutsideLineStyle = wdLineStyleSingle
.OutsideColorIndex = wdPink
.OutsideLineWidth = wdLineWidth300pt
End With
Next rngShape
End Sub
Sub TestRemoveBorders()
Dim rngShape As InlineShape
For Each rngShape In ActiveDocument.InlineShapes
With rngShape.Range.Borders
.OutsideLineStyle = wdLineStyleNone
End With
Next rngShape
End Sub
I am always left with a picture (inlineshape) that has a greyish border around it. Using "Picture Border > No Outline" on the Picture Tools > Format Tab removes it, but I can' find any way to do it in VBA. The wdLineStyleNone just doesn't seem to work and I can't see an option for colour = "none", or linewidth = "none"
Thank you.
From MSDN:
To remove all the borders from an object, set the Enable property to False.
http://msdn.microsoft.com/en-us/library/office/ff196058.aspx
This will remove the borders as you applied them:
Sub TestRemoveBorders()
Dim rngShape As InlineShape
For Each rngShape In ActiveDocument.InlineShapes
With rngShape.Range.Borders
.Enable = False
End With
Next rngShape
End Sub
The above method removes borders but not lines. To remove lines, try this:
With rngShape.Line
.Visible = msoFalse
End With
David's answer is correct, but I wanted to add to it for anyone who stumbles upon this later.
I prefer not to use the Borders method that I see most other people list to add a border to an InlineShape, and thanks to David's answer here I learned that you can just use the Line member like you can with normal Shapes!
I'm aware that this might not exactly answer the question for those of you who are not also setting the border yourself, but in my personal case it was helpful. With that in mind, here are the revised versions of methods to Add and Remove the borders from shapes.
Option Explicit
Sub PicturesAll_Borders_Show()
'for pictures which are "In Line with Text"
Dim inShp As InlineShape
For Each inShp In ActiveDocument.InlineShapes
If inShp.Type = wdInlineShapePicture Then
With inShp.Line
.Visible = True
.Style = msoLineSingle
.Weight = 1
.ForeColor.RGB = RGB(0, 0, 0)
End With
End If
Next inShp
'for pictures which are "With Text Wrapping"
Dim shp As Shape
For Each shp In ActiveDocument.Shapes
If shp.Type = msoPicture Then
With shp.Line
.Visible = True
.Style = msoLineSingle
.Weight = 1
.ForeColor.RGB = RGB(0, 0, 0)
End With
End If
Next shp
End Sub
Sub PicturesAll_Borders_Hide()
'for pictures which are "In Line with Text"
Dim inShp As InlineShape
For Each inShp In ActiveDocument.InlineShapes
If inShp.Type = wdInlineShapePicture Then inShp.Line.Visible = False
Next inShp
'for pictures which are "With Text Wrapping"
Dim shp As Shape
For Each shp In ActiveDocument.Shapes
If shp.Type = msoPicture Then shp.Line.Visible = False
Next shp
End Sub