Setting oSelection.ShapeRange.Width property blows up function only the SECOND time function is run! Weird!

forgot to mention - once that line is commented out I can run the function over and over and over, and it doesn't matter where in the section of code I put it, it always causes problems.

Have experienced the same problem with setting the inlineimage.width and .height property too

thanks

I have tried your code by taking out all the database stuff, and hard-coding the data to be inserted, but I can't make it fail.

Does it make any difference if the first Word application is still open or not?

This is the code that I am using. Can I ask you to change the picture paths to suit your system, and see if it still fails for you?

Private Sub cmdPrintIntroduction_Click()
    Dim oWordApp As Word.Application
    Dim oWordDoc As Word.Document
    Dim oRange As Word.Range
    Dim oSelection As Selection
    Dim cFont As String
    Dim cHeaderImage As String
    Dim cFooterLinePage2 As String
   
   
    'Create a new document in Word
    Set oWordApp = CreateObject("Word.Application")
    oWordApp.Visible = True
    Set oWordDoc = oWordApp.Documents.Add
    oWordDoc.PageSetup.RightMargin = 50
    oWordDoc.PageSetup.LeftMargin = 50
    oWordDoc.PageSetup.BottomMargin = 50
   
    cFont = 14
    cHeaderImage = "C:\Documents and Settings\Graham Skan\My Documents\My Pictures\" & "Bkg1.jpg"
   
   'Select Case Me.letter_choice
    Select Case 1
        Case 1
            'It is Saxton footer
            cFooterLinePage2 = "blah"
        Case 2
            'It is SSB footer
            cFooterLinePage2 = "blah"
        Case 3
            'It is QSB footer
            cFooterLinePage2 = "blah"
        Case 4
            'It is SNI footer
            cFooterLinePage2 = "blah"
        Case 5
            'It is E&S footer
            cFooterLinePage2 = "blah"
        Case 6
            cFooterLinePage2 = "blah"
    End Select
   
    With oWordDoc
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore (cFooterLinePage2)
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.Font.name = "Arial"
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.Font.Size = 5.5
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Sections(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture (cHeaderImage)
    End With

 
    Set oRange = oWordDoc.Range(0, 0)
   
    '**************************************************************************
    'Note because of the bizarre nature of this object and the way ranges work,
    'we need to build the document from the bottom up!
    '**************************************************************************
   
    With oRange
            .InsertBefore (vbCrLf & vbCrLf & "sIntroduction")
    End With
   
    With oRange
        .Font.name = "Helvetica"
        .Font.Size = cFont
        .ParagraphFormat.LineSpacing = 16
    End With
   
    Set oRange = oWordDoc.Range(0, 0)
   
    With oRange
         .InsertBefore (vbCrLf & vbCrLf & "INTRODUCTION")
    End With
   
    With oRange
        .Font.name = "Helvetica"
        .Font.Size = "18"
        .ParagraphFormat.LineSpacing = 10
    End With
   
    Set oRange = oWordDoc.Range(0, 0)
   
    With oRange
         '.InsertBefore (vbCrLf & rs1("sGivenName") & " " & rs1("sSurName"))
         .InsertBefore (vbCrLf & "sGivenName" & " " & "sSurName")
    End With
   
    With oRange
        .Font.name = "Helvetica"
        .Font.Size = "22"
        .Font.Bold = True
    End With
   
    oWordDoc.Sections(1).Range.Select
    oWordDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Set oSelection = oWordDoc.ActiveWindow.Selection
    oSelection.HeaderFooter.Shapes.AddPicture(Filename:="C:\Documents and Settings\Graham Skan\My Documents\My Pictures\" & "Sample.jpg", LinkToFile:=False, SaveWithDocument:=True).Select
    oSelection.ShapeRange.PictureFormat.Brightness = 0.5
    oSelection.ShapeRange.PictureFormat.Contrast = 0.5
    oSelection.ShapeRange.LockAspectRatio = True
    oSelection.ShapeRange.WrapFormat.AllowOverlap = True
    oSelection.ShapeRange.WrapFormat.Side = wdWrapNone
    oSelection.ShapeRange.WrapFormat.Type = 3
    oSelection.ShapeRange.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
    oSelection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
    oSelection.ShapeRange.Left = wdShapeCenter
    oSelection.ShapeRange.Top = wdShapeBottom
    oSelection.ShapeRange.Width = CentimetersToPoints(22.46)
    oWordDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
   
    Set oWordDoc = Nothing
    Set oWordApp = Nothing
             

End Sub

hi thanks for helping out

with the prior version of code - the test model - it DID made a difference whether the previous word document was open or not - even though I closed all objects (see bottom of code), it kept referring to the previous document the second time it ran - for example it would insert a background image numerous times into "document1," the first it created - but I fixed this by localising the oSelection.ShapeRange.Width object - ( note when the error happened, this created the same error message as I in the second instance above, so it IS a similar issue... )

...then in the most recent code version, which had fixed the problem above by localising the oSelection object, it was totally fixed and working fine until added the oSelection width aspect to expand the image beyond the margins  - then it started failing again, but in a slightly different way - the error message is exactly the same, but it fails specifically on that one line, not on any other -

thats the weird thing - it's indicating that there is no object anymore, but it is erroring out on the LAST oSelection staement, which implies it is not the object!  so what the?

why would the status change jumping from

    oSelection.ShapeRange.Top = wdShapeBottom

to

    oSelection.ShapeRange.Width = CentimetersToPoints(22.46)

??

i'm watchin a move for a while will check back in over the weekend

thanks for helpin

marc

You might try replacing the code portion with one that avoids using the Selection object:

    Dim sh As Word.Shape

    Set oRange = oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
    oRange.Collapse wdCollapseEnd
    Set sh = oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Shapes.AddPicture _
        (Filename:=rs2("image_directory") & "yellowbrickroad.jpg", _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Anchor:=ORange)
    sh.PictureFormat.Brightness = 0.5
    sh.PictureFormat.Contrast = 0.5
    sh.LockAspectRatio = True
    sh.WrapFormat.AllowOverlap = True
    sh.WrapFormat.Side = wdWrapNone
    sh.WrapFormat.Type = 3
    sh.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
    sh.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
    sh.Left = wdShapeCenter
    sh.Top = wdShapeBottom
    sh.Width = CentimetersToPoints(22.46)

ok, so, I have tried bot of your approaches

--- first approach --- using the entire new function provided above

this one worked the best - I could run the routine again and again without errors but only if I kept the word documents open.  as soon as I closed all the generated docs, and ran it again, I got the same error:

Runtime error '462'

The remote server machine does not exist or is unavailable.

--- second approach - using only the smaller modification (without the selection object)

sure enough, same thing happens - first time I run it, it's fine, then the second time I run it I get the same error on the centimeterstopoints call

Runtime error '462'

The remote server machine does not exist or is unavailable.

tough one huh...

Marc

Hi Marc,

The first code was not an attempt to fix the problem, but to try to simplify the code for testing purposes.

The second was a start in doing it differently. What I want to do eventually is to include the size and position parameters in the AddPicture method call. I do have a problem because I think the relative position properties for the object have to be set before they are used, and obviously they can't be set before the object is created. This means that the postioning is wrong, but I can't be sure how to tweak it because my document and pictures are obviously different from yours.

I'll carry on trying.

Is there any way I can help, perhaps send you the image? I would need your email address obviously.
Marc

eMail addreses are (slightly disguised) in my profile. Use the first one.

Graham, I have retested by changing the dimensions of the image to

    oSelection.ShapeRange.Width = CentimetersToPoints(10)

which is well within the margins of the page.

This has had no effect on the situation.

So there's no point sending you the image, because it doesn't matter.

Note, something new has cropped up, if I include the .width line, it only causes an error under the following conditions

1) I run the function the first time and create the first doc.  It's perfect and the .width line works
2) I delete the first doc
3) I run it again and it errors out on the .width line

Under the following conditions it does NOT cause an error:

1) I run the function the first time and create the first doc.  It's perfect.
2) I do NOT delete the doc
3) I run the function again and it creates a perfect second doc
4) I do NOT delete the second doc
5) I run the function again and it creates a perfect third doc.
6) etc...

So it is only causing an error now when I actually delete the doc.

And if I put on error resume next in there, the only line of code that is skipped is the one that extends the width of the image, so it's not the end of the world.

If you want to keep working on it great, but if not I understand.

Just to keep things clear following is the code I'm currently using

thanks

Marc

_________________________________________________


Private Sub cmdPrintProfile_Click()
    Dim oWordApp As Word.Application
    Dim oWordDoc As Word.Document
    Dim oRange As Word.Range
    Dim myrange As Word.Range
    Dim myTable As Table
    Dim oSelection As Selection
    Dim sh As Word.Shape
   
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rs3 As DAO.Recordset
    Dim rs4 As DAO.Recordset
    Dim rs5 As DAO.Recordset
   
    Dim bLink As Boolean
    Dim bSaveWithdoc As Boolean
    Dim sSql As String
    Dim cFont As String
    Dim cHeaderImage As String
    Dim tbl As TableDef
    Dim i As Integer
    Dim nResult As Integer
    Dim cFullname As String
    Dim cFooterLinePage2 As String
   
    bLink = False
    bSaveWithdoc = False
   
    On Error Resume Next
   
    'Create a new document in Word
    Set oWordApp = CreateObject("Word.Application")
    oWordApp.Visible = True
    Set oWordDoc = oWordApp.Documents.Add
    oWordDoc.PageSetup.RightMargin = 50
    oWordDoc.PageSetup.LeftMargin = 50
    oWordDoc.PageSetup.BottomMargin = 60
   
    ' Open images table
    Set db = CurrentDb
   
    Set rs = db.OpenRecordset("SELECT dbo_tbl_Speaker_Profile.iSpeakerID, dbo_tbl_Speaker_Profile.sOneLiners FROM dbo_tbl_Speaker_Profile WHERE dbo_tbl_Speaker_Profile.iSpeakerID = " & Me.iSpeakerID)
    Set rs1 = db.OpenRecordset("Select iSpeakerID,sSurname,sGivenName,iExclusiveLevel FROM dbo_tbl_Speaker WHERE iSpeakerID = " & Me.iSpeakerID, dbOpenForwardOnly, dbSeeChanges)
    Set rs2 = db.OpenRecordset("Select * from dbo_tbl_config", dbOpenForwardOnly, dbSeeChanges)
    Set rs5 = db.OpenRecordset("Select * from dbo_tbl_Speaker_Comments WHERE iSpeakerID = " & Me.iSpeakerID, dbOpenForwardOnly, dbSeeChanges)
   
    cFont = rs2("font_size_profile")
    cHeaderImage = rs2("image_directory") & "saxton_header_for_profile.jpg"
   
    Set myrange = oWordDoc.Range(Start:=0, End:=0)
    oWordDoc.Tables.Add Range:=myrange, NumRows:=1, NumColumns:=2
    Set myTable = oWordDoc.Tables(1)
    myTable.Columns(1).Width = 360
    myTable.Columns(2).Width = 185
    myTable.LeftPadding = 30
   
    If Me.letter_choice = 1 Then
        'It is Saxton footer
        cFooterLinePage2 = "blah"
    End If
    If Me.letter_choice = 2 Then
        'It is SSB footer
        cFooterLinePage2 = "blah"
    End If
    If Me.letter_choice = 3 Then
        'It is QSB footer
        cFooterLinePage2 = "blah"
    End If
    If Me.letter_choice = 4 Then
        'It is SNI footer
        cFooterLinePage2 = "blah"
    End If
    If Me.letter_choice = 5 Then
        'It is E&S footer
        cFooterLinePage2 = "blah"
    End If
    If Me.letter_choice = 6 Then
        cFooterLinePage2 = "blah"
    End If
   
    With oWordDoc
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore (cFooterLinePage2)
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.Font.Name = "Arial"
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.Font.Size = 5.5
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Sections(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture (cHeaderImage)
    End With
   
    If IsNull(rs1("sGivenName")) Then
        cGivenName = ""
    Else
        cGivenName = StripName(Trim(rs1("sGivenName")))
    End If
    If IsNull(rs1("sSurname")) Then
        cSurname = ""
    Else
        cSurname = StripName(Trim(rs1("sSurname")))
    End If
   
    If cGivenName = "" Or cGivenName = Null Then
        cFullname = cSurname
        cFullname1 = rs1("sSurname")
    Else
        cFullname = cGivenName & "_" & cSurname
        cFullname1 = rs1("sGivenname") & " " & rs1("sSurname")
    End If
   

    '**************************************************************************
    'Note because of the bizarre nature of this object and the way ranges work,
    'we need to build the document from the bottom up!
    '**************************************************************************
   
    If Not rs5.EOF Then
        Set oRange = oWordDoc.Range(0, 0)
   
        With oRange
            .InsertBefore (vbCrLf & vbCrLf & "Click here to read Client Comments about " & rs1("sGivenName") & " " & rs1("sSurName"))
            oWordDoc.Hyperlinks.Add Address:="http://www.saxton.com.au/client_comments/" & cFullname & "_" & Me.iSpeakerID & ".html", Anchor:=oRange
        End With
       
        With oRange
            .Font.Name = "Verdana"
            .Font.Size = cFont
            .Font.Color = wdColorDarkBlue
            .Font.Bold = True
        End With
   
    End If
   
    If rs1("iExclusivelevel") = 1 Then
        ' We have an exclusive speaker which will have a full length profile
        Set oRange = oWordDoc.Range(0, 0)
       
        With oRange
            .InsertBefore (vbCrLf & vbCrLf & "Click to Read Full-Length Profile for " & rs1("sGivenName") & " " & rs1("sSurName"))
            oWordDoc.Hyperlinks.Add Address:="http://www.saxton.com.au/default.asp?nc8=4&sc8=140&sd8=" & Me.iSpeakerID, Anchor:=oRange
        End With
       
        With oRange
            .Font.Name = "Verdana"
            .Font.Size = cFont
            .Font.Color = wdColorDarkBlue
            .Font.Bold = True
        End With
       
    End If
   
    Set oRange = oWordDoc.Range(0, 0)
   
    With oRange
        If Not IsNull(rs("sOneLiners")) Then
            .InsertBefore (vbCrLf & vbCrLf & StripHTML(rs("sOneLiners")))
        End If
    End With
   
    With oRange
        .Font.Name = "Verdana"
        .Font.Size = cFont
        .ParagraphFormat.Alignment = wdAlignParagraphJustify
        .Font.Bold = False
    End With
   
    Set oRange = oWordDoc.Range(0, 0)
   
    If rs1("iExclusiveLevel") = 1 Then
        With oRange
             .InsertBefore (vbCrLf & "Exclusively represented by Saxton")
        End With
       
        With oRange
            .Font.Name = "Verdana"
            .Font.Size = "10"
            .Font.Italic = True
        End With
    End If
   
    Set oRange = oWordDoc.Range(0, 0)
   
    With oRange
         .InsertBefore (cFullname1)
    End With
   
    With oRange
        .Font.Name = "Verdana"
        .Font.Size = "12"
        .Font.Bold = True
        .Font.Italic = False
    End With
           
    With oWordDoc.Tables(1).Cell(1, 2)
       
        Set rs3 = db.OpenRecordset("SELECT * from dbo_tbl_Images WHERE [iSpeakerID] = " & rs("iSpeakerId") & " AND [iImageTypeID] = 2")
        If Not rs3.EOF Then
            If rs3("sImageLocation") <> "" Then
                With oWordDoc.InlineShapes.AddPicture(rs3("sImageLocation"), True, True, .Range)
                    .Borders.Enable = True
                    .Borders.OutsideLineWidth = wdLineWidth100pt
                End With
            End If
        End If
               
        Set rs4 = db.OpenRecordset("SELECT iSpeakerID,cTopic from dbo_tbl_Topics WHERE [iSpeakerID] = " & rs("iSpeakerId"))

        If Not rs4.EOF Then
            .Range.InsertAfter (vbCrLf & vbCrLf & "Speaking Topics" & vbCrLf)
        End If
       
        Do While Not rs4.EOF
            .Range.InsertAfter (vbCrLf & Chr(149) & " " & rs4("cTopic"))
            rs4.MoveNext
        Loop
       
        .Range.Font.Name = "Verdana"
        .Range.Font.Size = 8
        .Range.Font.Color = wdColorDarkBlue
       
    End With
   
   
    oWordDoc.Sections(1).Range.Select
    oWordDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Set oSelection = oWordDoc.ActiveWindow.Selection
    oSelection.HeaderFooter.Shapes.AddPicture(FileName:=rs2("image_directory") & "yellowbrickroad.jpg", LinkToFile:=False, SaveWithDocument:=True).Select
    oSelection.ShapeRange.PictureFormat.Brightness = 0.5
    oSelection.ShapeRange.PictureFormat.Contrast = 0.5
    oSelection.ShapeRange.LockAspectRatio = True
    oSelection.ShapeRange.WrapFormat.AllowOverlap = True
    oSelection.ShapeRange.WrapFormat.Side = wdWrapNone
    oSelection.ShapeRange.WrapFormat.Type = 3
    oSelection.ShapeRange.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
    oSelection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
    oSelection.ShapeRange.Left = wdShapeCenter
    oSelection.ShapeRange.Top = wdShapeBottom
    oSelection.ShapeRange.Width = CentimetersToPoints(22.5)
    oWordDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
       
    Set oWordDoc = Nothing
    Set oWordApp = Nothing
    Set rs = Nothing
    Set rs2 = Nothing
    Set rs1 = Nothing
    Set rs3 = Nothing
    Set rs4 = Nothing
    Set rs5 = Nothing
    Set db = Nothing
   
    Exit Sub

             
End Sub

My goodness, it's been solved!

Simply placing the width parameter inside the addpicture method eliminated the errors.

It now works perfectly.

Thanks!

Woops - Spoke too soon.
Now I have the same error on the addpicture line if I close the original doc and try to rerun it.
If I don't close the first doc, it runs forever.  As soon as I close the first doc, I get the error on the addpicture line.
This is simply taking too much time, I'm going to drop it and just not have the image extra wide.
Thanks for your help.
Marc

Interesting. It still looks like some sort of bug, where it was losing the pointer to the object.

Thanks for the grade & good luck

Sorry, crossed posting. Missed your last comment.

OK. Come back to it later, perhaps after you've had to re-install or add service packs for some other reason.

I don't think it's a bug on my system, but I'll look into that and let you know...eventually.
Cheers
Marc