Results 1 to 6 of 6
  1. #1
    Platinum Lounger
    Join Date
    Dec 2000
    Location
    Queanbeyan, New South Wales, Australia
    Posts
    3,730
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Code to place figures in a document

    The following code was posted in the Word forum. Phil R suggested I put the post (and my response/changes) in the VBA forum.

    The original post was from Rajesh:


    Here goes the code. It was written some time back, and I haven't run it again to iron out any deficiencies. Also, not too well-documented. Sorry for that.

    <pre>Sub insertimage()
    '
    ' insertimage Macro
    ' Macro recorded 1/5/01 by Rajesh H
    '
    ' Inserting a top aligned text box

    'For I = 0 To 1
    ActiveDocument.Shapes.AddTextbox(msoTextOrientatio nHorizontal, 90#, _
    72#, 261#, 90#).Select
    Application.ScreenUpdating = False
    Selection.ShapeRange.TextFrame.TextRange.Select
    Selection.Collapse
    Selection.ShapeRange.Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 90#
    Selection.ShapeRange.Width = 340#
    Selection.ShapeRange.TextFrame.MarginLeft = 0#
    Selection.ShapeRange.TextFrame.MarginRight = 0#
    Selection.ShapeRange.TextFrame.MarginTop = 0#
    Selection.ShapeRange.TextFrame.MarginBottom = 0#
    Selection.ShapeRange.RelativeHorizontalPosition = _
    wdRelativeHorizontalPositionColumn
    Selection.ShapeRange.RelativeVerticalPosition = _
    wdRelativeVerticalPositionPage
    Selection.ShapeRange.Left = wdShapeCenter
    Selection.ShapeRange.Top = wdShapeTop
    Selection.ShapeRange.LockAnchor = False
    Selection.ShapeRange.WrapFormat.AllowOverlap = False
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = 0
    Selection.ShapeRange.WrapFormat.DistanceBottom = 18
    Selection.ShapeRange.WrapFormat.DistanceLeft = 9
    Selection.ShapeRange.WrapFormat.DistanceRight = 9
    Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 90#
    Selection.ShapeRange.Width = 261#
    Selection.ShapeRange.TextFrame.MarginLeft = 0#
    Selection.ShapeRange.TextFrame.MarginRight = 0#
    Selection.ShapeRange.TextFrame.MarginTop = 0#
    Selection.ShapeRange.TextFrame.MarginBottom = 0#
    Selection.ShapeRange.RelativeHorizontalPosition = _
    wdRelativeHorizontalPositionColumn
    Selection.ShapeRange.RelativeVerticalPosition = _
    wdRelativeVerticalPositionMargin
    Selection.ShapeRange.Left = wdShapeCenter
    Selection.ShapeRange.Top = wdShapeTop
    Selection.ShapeRange.LockAnchor = False
    Selection.ShapeRange.WrapFormat.AllowOverlap = False
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = 0
    Selection.ShapeRange.WrapFormat.DistanceBottom = 18
    Selection.ShapeRange.WrapFormat.DistanceLeft = 0
    Selection.ShapeRange.WrapFormat.DistanceRight = 0
    Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
    Application.ScreenUpdating = True

    'Next I


    ' comes over here

    Fname = InputBox("Enter the file name", "File Name", "Pic01f")
    On Error GoTo imgerrormsg

    Selection.InlineShapes.AddPicture FileName:= _
    "H:ARTWORKCurrentJobPictures" & Fname & ".eps", LinkToFile:=True, SaveWithDocument _
    :=False

    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

    Selection.InlineShapes(1).Reset
    Y = Selection.InlineShapes(1).Height
    x = Selection.InlineShapes(1).Width
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    Selection.ShapeRange.Height = Y
    Selection.ShapeRange.Width = x

    Selection.MoveLeft Unit:=wdCharacter, Count:=1

    'Another text box for Image Caption

    ActiveDocument.Shapes.AddTextbox(msoTextOrientatio nHorizontal, 90#, _
    72#, 261#, 90#).Select
    Application.ScreenUpdating = False
    Selection.ShapeRange.TextFrame.TextRange.Select
    Selection.Collapse
    Selection.ShapeRange.Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 90#
    Selection.ShapeRange.Width = 340#
    Selection.ShapeRange.TextFrame.MarginLeft = 0#
    Selection.ShapeRange.TextFrame.MarginRight = 0#
    Selection.ShapeRange.TextFrame.MarginTop = 0#
    Selection.ShapeRange.TextFrame.MarginBottom = 0#
    Selection.ShapeRange.LockAnchor = False
    Selection.ShapeRange.WrapFormat.AllowOverlap = False
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = 0
    Selection.ShapeRange.WrapFormat.DistanceBottom = 18
    Selection.ShapeRange.WrapFormat.DistanceLeft = 9
    Selection.ShapeRange.WrapFormat.DistanceRight = 9
    Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 90#
    Selection.ShapeRange.Width = 340.15
    Selection.ShapeRange.TextFrame.MarginLeft = 0#
    Selection.ShapeRange.TextFrame.MarginRight = 0#
    Selection.ShapeRange.TextFrame.MarginTop = 0#
    Selection.ShapeRange.TextFrame.MarginBottom = 0#
    Selection.ShapeRange.RelativeHorizontalPosition = _
    wdRelativeHorizontalPositionColumn
    Selection.ShapeRange.RelativeVerticalPosition = _
    wdRelativeVerticalPositionMargin
    Selection.ShapeRange.Left = wdShapeCenter
    Selection.ShapeRange.Top = Y
    Selection.ShapeRange.LockAnchor = False
    Selection.ShapeRange.WrapFormat.AllowOverlap = False
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = 0
    Selection.ShapeRange.WrapFormat.DistanceBottom = 18
    Selection.ShapeRange.WrapFormat.DistanceLeft = 0
    Selection.ShapeRange.WrapFormat.DistanceRight = 0
    Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
    Application.ScreenUpdating = True

    Selection.ShapeRange.RelativeVerticalPosition = _
    wdRelativeVerticalPositionMargin
    Selection.ShapeRange.Top = Y


    'Comes over here

    imgerrormsg:
    MsgBox "Check-it-out the image name in H:ArtworkCurrentJobPictures*.* Path", vbCritical
    End Sub


    </pre>

    Subway Belconnen- home of the Signboard to make you smile. Get (almost) daily updates- follow SubwayBelconnen on Twitter.

  2. #2
    Platinum Lounger
    Join Date
    Dec 2000
    Location
    Queanbeyan, New South Wales, Australia
    Posts
    3,730
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Code to place figures in a document

    My original reply in the Word forum:

    two quick comments (without testing the code):

    1. You are doing very similar things several times. It may be useful to put those common bits of code into a routine. Not only do you make the code easier to maintain and understand, but you can be starting the building blocks for stuff you do later.

    2. (A favourite bugbear of mine- ever since I found out about it- 12 months after starting VBA).
    Using ranges instead of selections can improve efficiency of code drastically. "Selection" involves changing screen displays; range does not. This means the changes in response time become much more than just academic- they can be quite noticable.

    *****************
    Phil's response: I know how to replace a series of "Selection" with "With Selection/End With". Using some of his code above, could you give an example of how to change the "Selection" method to a "Range" method?

    In testing the macro, I notice that even though I've made appropriate path & name modifications, a picture inserts, but the error message always comes up at the end. It seems that the command labelled "imgerrormsg:" always shows the message box. Is there a way to skip that message box when there is no error?
    ******************
    My response;

    I've come up with something which uses a common routine, and which eliminates the error message at the end.

    I've run out of time just at the moment. I started using a "range" instead of "seecltion", but some of the shape movements did not apply to a range. So I may have to take back my comments about selection (at least in respect to shapes).

    And, by the way, Rajesh, thanks for posting the code. The idea was great. But, as is typical with recording code and then modifying, it often needs cleaning up later.

    <pre>Option Explicit
    Dim rngShapeRange As Range
    Sub insertimage()
    '
    ' insertimage Macro
    ' Macro recorded 1/5/01 by Rajesh H
    '
    ' Inserting a top aligned text box
    Dim fName As String
    Dim Y As Long
    Dim X As Long

    Dim strSource As String

    ' using strSource enables easy testing on another computer
    strSource = "H:ARTWORKCurrentJobPictures"

    'For I = 0 To 1
    ActiveDocument.Shapes.AddTextbox(msoTextOrientatio nHorizontal, 90#, _
    72#, 261#, 90#).Select
    Application.ScreenUpdating = False

    Selection.ShapeRange.TextFrame.TextRange.Select
    Selection.ShapeRange.Select

    ' starting to use range. I got no further
    Set rngShapeRange = Selection.Range
    Call FillShape(340, 9, 9)
    Call FillShape(261, 0, 0)
    Application.ScreenUpdating = True

    'Next I


    ' comes over here

    fName = InputBox("Enter the file name", "File Name", "Pic01f")
    On Error GoTo imgerrormsg

    Selection.InlineShapes.AddPicture FileName:=strSource & fName & ".eps", _
    LinkToFile:=True, SaveWithDocument:=False

    On Error GoTo 0 ' Reset the error processing

    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

    Selection.InlineShapes(1).Reset
    Y = Selection.InlineShapes(1).Height
    X = Selection.InlineShapes(1).Width
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    Selection.ShapeRange.Height = Y
    Selection.ShapeRange.Width = X

    Selection.MoveLeft Unit:=wdCharacter, Count:=1

    'Another text box for Image Caption

    ActiveDocument.Shapes.AddTextbox(msoTextOrientatio nHorizontal, 90#, _
    72#, 261#, 90#).Select
    Application.ScreenUpdating = False
    Selection.ShapeRange.TextFrame.TextRange.Select
    Selection.Collapse
    Selection.ShapeRange.Select
    Call FillShape(340, 9, 9)
    Call FillShape(340.15, 0, 0)

    Application.ScreenUpdating = True

    Selection.ShapeRange.RelativeVerticalPosition = _
    wdRelativeVerticalPositionMargin
    Selection.ShapeRange.Top = Y


    'Comes over here
    Exit Sub ' for the error message to to be displayed

    imgerrormsg:
    MsgBox "Check-it-out the image name in " & strSource & "*.* Path", vbCritical
    End Sub

    Sub FillShape(Height As Single, DistanceLeft As Long, DistanceRight As Long)

    With Selection
    .ShapeRange.Fill.Visible = msoFalse
    .ShapeRange.Fill.Transparency = 0#
    .ShapeRange.Line.Weight = 0.75
    .ShapeRange.Line.DashStyle = msoLineSolid
    .ShapeRange.Line.Style = msoLineSingle
    .ShapeRange.Line.Transparency = 0#
    .ShapeRange.Line.Visible = msoFalse
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 90#
    .ShapeRange.Width = Height
    .ShapeRange.TextFrame.MarginLeft = 0#
    .ShapeRange.TextFrame.MarginRight = 0#
    .ShapeRange.TextFrame.MarginTop = 0#
    .ShapeRange.TextFrame.MarginBottom = 0#
    .ShapeRange.RelativeHorizontalPosition = _
    wdRelativeHorizontalPositionColumn
    .ShapeRange.RelativeVerticalPosition = _
    wdRelativeVerticalPositionPage
    .ShapeRange.Left = wdShapeCenter
    .ShapeRange.Top = wdShapeTop
    .ShapeRange.LockAnchor = False
    .ShapeRange.WrapFormat.AllowOverlap = False
    .ShapeRange.WrapFormat.Side = wdWrapBoth
    .ShapeRange.WrapFormat.DistanceTop = 0
    .ShapeRange.WrapFormat.DistanceBottom = 18
    .ShapeRange.WrapFormat.DistanceLeft = 9
    .ShapeRange.WrapFormat.DistanceRight = 9
    .ShapeRange.WrapFormat.Type = wdWrapTopBottom
    End With
    End Sub

    </pre>

    Subway Belconnen- home of the Signboard to make you smile. Get (almost) daily updates- follow SubwayBelconnen on Twitter.

  3. #3
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Los Angeles Area, California, USA
    Posts
    7,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Code to place figures in a document

    Hi Geoff:

    Tried it out & seems to work. I would tweak the text boxes, but that's a matter of taste. This macro would work well if all the images are in the same folder & if all extensions are the same. I suppose it would be useful to be able to subsitute in another path if all images weren't in the same place & substitute extensions if there were several different formats.

    I suppose that to change the extensions would simply be not to add them automatically & just consider them part of the filename. i.e. use

    Selection.InlineShapes.AddPicture FileName:=strSource &_ fName,

    where fName includes the extension. Thanks for the instruction.

  4. #4
    Platinum Lounger
    Join Date
    Dec 2000
    Location
    Queanbeyan, New South Wales, Australia
    Posts
    3,730
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Code to place figures in a document

    Phil,

    So you're learning VBA (hopefully painlessly)?

    There's probably heaps could be done to the code- as with most recorded code. All I've done are a few quick bits to make it a little easier to read and change.

    It might be useful to add a "fileopen" dialog box- so that the user could select from a real list, instead of just typing in something. That would help out with problems with extensions and file paths.

    I'm still learning about range and selection myself. I don't know about shapes and such, so I might have to leave that bit alone for now.
    Subway Belconnen- home of the Signboard to make you smile. Get (almost) daily updates- follow SubwayBelconnen on Twitter.

  5. #5
    Super Moderator
    Join Date
    Dec 2000
    Location
    New York, NY
    Posts
    2,970
    Thanks
    3
    Thanked 29 Times in 27 Posts

    Re: Code to place figures in a document

    Hi Geoff, Phil:

    I'm back after 8 days offline to find 600+ new postings in Word/VB-VBA - WOW this place is busy - how does one catch up?

    Two quick comments:

    (1) Thinking back on the dozen or so routines I've written in the past year that work on Shapes, it seems like I had to use Selection to address the Shape objects correctly; in fact they usually needed to be selected before changing their properties.

    Interesting to conjecture whether this is necessary due to some intrinsic property of Shapes, or whether it reflects an imperfect implementation of Word VBA with regard to shapes. Geoff, when addressing shapes in Excel VBA, do you find the Range object tends to work properly or do you need to use Selection there as well?

    (2) With/End With:
    "With Selection
    'statements
    End With"

    works well to tidy up the look of the code, but (according to Ken Getz), really does nothing to speed up code execution because it doesn't reduce the "dot count".

    In the current sample code, this could have been done with "With Selection.ShapeRange" or by assigning an object variable to Selection.ShapeRange.

    Gary

  6. #6
    Platinum Lounger
    Join Date
    Dec 2000
    Location
    Queanbeyan, New South Wales, Australia
    Posts
    3,730
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Code to place figures in a document

    Gary,

    In regards to the selection object, I am only speaking (unfortunately) from my experience with text type objects. I am finding out that shapes, charts, etc are another world, and I shot off my mouth too soon.

    When I select an item in a chart- an axis, background etc, "selection" appears to take on the properties of the object (fair enough when I think about it). And those properties I cannot necessarily apply to a range.

    Yes, "if selection" certainly does tidy up code. It saves a lot of typing if I was entering it from scratch- and makes it easier to read. It illustrates a point. Performance- in this example, not a consideration.

    Right or wrong, I only really worry about performance when it stands out as an issue. I'll keep it in mind, and try to write efficient code. If code takes more than 3 seconds to execute, I'll spend a little time. If it takes 30 seconds, I'll spend more time (if I am going to have to execute it very frequently).

    Just some random late night thoughts
    Subway Belconnen- home of the Signboard to make you smile. Get (almost) daily updates- follow SubwayBelconnen on Twitter.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •