Code to format Word Pictures works 1st run but won't on subsequent run

[rceddy]

I have code in Excel 2003 to paste Excel ranges into Word as pictures. I want to paste the picture into the Word document and resize to a nice printing size then add the next one after a section break and so on. There are several different macros that have the same paste and format into Word so it is broken out into 2 macros.

This code works on the first run but will not format the Word document size or picture sizes on subsequent runs. It will center the pictures on subsequent run. If Excel is closed then reopened, the first run works wonderfully but not subsequently. I can't figure out why. I've tried working with the record macros to no avail.

I added a line of code to test that it was the correct picture by selecting it. It did so I removed that line.

BTW -- I only have a little knowledge about VBA so please keep this in mind.

Public PageType, RecType
Public SendVar, SendVar2


Sub SendCigPages()

    Dim Message, Message2, Title, Response
    Dim MyDir, MyPath
    Dim WdObjRec As Word.Application
    Dim Var
    
    Application.ScreenUpdating = False
              
    MyPath = ActiveWorkbook.Path
    Message = "Did you enter the number of pages? "
    Title = "Page Number Check"
    Message2 = "TheWord document has been created." & Chr(13) & Chr(13) & _
        "The document is located in the Print folders in " & MyPath & "."
    
    SendVar = 1
    SendVar2 = 0
    RecType = "Cig"
    
    Response = MsgBox(Message, vbYesNo, Title)
    
    If Response = 7 Then
        MsgBox ("The print job has been cancelled.")
        Sheets("INFO").Visible = False
        Exit Sub
    End If
    
    'Sends AD-7s
    Range("AD_7").Copy
    PageType = 1
    ExceltoWordCig
    
    Range("AD_7EX").Copy
    PageType = 1
    ExceltoWordCig
                 
    SendAdjPagesCig ‘This is code to collect pages that the user can check off, same type of code as is here
    
    SendVar2 = 1
    ExceltoWordCig
    
    SendVar = Empty
    SendVar2 = Empty
    RecType = Empty
    PageType = Empty
    
    Application.ScreenUpdating = True

    Sheets("Options").Select
    Range("A1").Select
    ActiveCell.Offset(0, 0).Range("A1").Select
    MsgBox (Message2)

End Sub

Sub ExceltoWordCig()
    'Code to paste Excel pages into Word as pictures
    Dim WdObjRec As Word.Application
    Dim Var, Var2, FileName, RcName, MyPath, MyDir, RecFile, MyFile
    
    MyDir = ActiveWorkbook.Path
    MyPath = MyDir & "\Print" + RecType + "\" & RecType & "AuditFile.doc"
    On Error Resume Next
    
    Set WdObjRec = GetObject(, "Word.application")
        
    If Err <> 0 Then
        Set WdObjRec = CreateObject("Word.application")
        WdObjRec.WindowState = wdWindowStateNormal
        Err.Clear
    End If
   
    WdObjRec.Visible = True
    
    If SendVar2 = 0 Then
        
        If SendVar = 1 Then
            WdObjRec.Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
            
            With WdObjRec.ActiveDocument.PageSetup
                .TopMargin = InchesToPoints(0.6)
                .BottomMargin = InchesToPoints(0.6)
                .LeftMargin = InchesToPoints(0.7)
                .RightMargin = InchesToPoints(0.7)
                .Gutter = InchesToPoints(0)
                .HeaderDistance = InchesToPoints(0)
                .FooterDistance = InchesToPoints(0)
                .PageWidth = InchesToPoints(8.5)
                .PageHeight = InchesToPoints(11)
            End With
            
            WdObjRec.ActiveDocument.SaveAs FileName:=MyPath 'Saves file as variable name
            WdObjRec.Selection.HomeKey unit:=wdStory                      'Moves to first line
        
        End If
        
        If PageType = 1 Then         'Set up for portrait
            WdObjRec.Selection.PageSetup.Orientation = wdOrientPortrait
            WdObjRec.Selection.PasteSpecial , DataType:=wdPasteMetafilePicture
    
            WdObjRec.ActiveDocument.Shapes(SendVar).Left = wdShapeCenter
            WdObjRec.ActiveDocument.Shapes(SendVar).Top = wdShapeCenter
            WdObjRec.ActiveDocument.Shapes(SendVar).LockAspectRatio = msoCTrue
            WdObjRec.ActiveDocument.Shapes(SendVar).Height = InchesToPoints(9.5)
        Else                        'Sets page up for landscape pages
            
            WdObjRec.Selection.PageSetup.Orientation = wdOrientLandscape
            WdObjRec.Selection.PasteSpecial , DataType:=wdPasteMetafilePicture
            
            WdObjRec.ActiveDocument.Shapes(SendVar).LockAspectRatio = msoTrue
            WdObjRec.ActiveDocument.Shapes(SendVar).Width = InchesToPoints(9.2)
            WdObjRec.ActiveDocument.Shapes(SendVar).Left = wdShapeCenter
            WdObjRec.ActiveDocument.Shapes(SendVar).Top = wdShapeCenter
            
        End If
                
        WdObjRec.Selection.EndKey unit:=wdStory
        WdObjRec.Selection.InsertBreak Type:=wdSectionBreakNextPage
        Application.CutCopyMode = False
        WdObjRec.ActiveDocument.Save
    Else
        WdObjRec.ActiveDocument.Close SaveChanges:=True
        WdObjRec.Application.Quit
    End If
        
    SendVar = SendVar + 1
    Set WdObjRec = Nothing

End Sub

 

[SkipVought]

Hi,

"...then add the next one after a section break and so on."

SendVar never gets to be more than 2, does it? How is the and so on supposed to happen?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[rceddy]

The SendVar is advanced near the end of the second marco with SendVar = SendVar + 1 so each time a picture is pasted the counter is advanced.

 

[SkipVought]

Have you put a break in your code so that you can see what's happening?

Debug.Print and the Watch Window can help to determine what's happening to your variables.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Andrzejek]

You do realize that all these variables are Variants:

Public [b]PageType, RecType[/b]
Public [b]SendVar, SendVar2[/b]

Sub SendCigPages()

    Dim [b]Message, Message2, Title, Response[/b]
    Dim [b]MyDir, MyPath[/b]
    Dim [b]Var[/b]

Sub ExceltoWordCig()

    Dim [b]Var, Var2, FileName, RcName, MyPath, MyDir, RecFile, MyFile[/b]

Have fun.

---- Andy

 

[rceddy]

I didn't think it made any difference about the variables so I had not considered that. I did go back and change the variables to either string or integer. The macro still worked the first time and not thereafter.

I tried the Watch very interesting. I didn't see any difference in the variables from run to run.

I did find a strange thing when recording a macro on the document that worked. I cannot click on the picture and select it but selecting it another way allows me to size. When recording a macro on the document that didn't format, I could click on the picture and bring up the properties window but the size would not change. I don't know what that means. Any ideas on that?

I appreciate the suggestions.

 

[SkipVought]

Did you actually inspect the value of SendVar each time it incriments? How far did it incriment?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

and what is it doin the FIRST time that you run it this is NOT happening in subsequent runs?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[rceddy]

The first time that the macro runs it will format the new Word document size and format the shape size. It will not allow the size formatting in subsequent runs unless Excel is shutdown and restarted.

These are the lines that will not run:

            With WdObjRec.ActiveDocument.PageSetup
                .TopMargin = InchesToPoints(0.6)
                .BottomMargin = InchesToPoints(0.6)
                .LeftMargin = InchesToPoints(0.7)
                .RightMargin = InchesToPoints(0.7)
                .Gutter = InchesToPoints(0)
                .HeaderDistance = InchesToPoints(0)
                .FooterDistance = InchesToPoints(0)
                .PageWidth = InchesToPoints(8.5)
                .PageHeight = InchesToPoints(11)
            End With

and

            WdObjRec.ActiveDocument.Shapes(SendVar).Height = InchesToPoints(9.5)

and

            WdObjRec.ActiveDocument.Shapes(SendVar).Width = InchesToPoints(9.2)

Also I cannot go into the subsequent Word documents, run the macro recorder and change the size.

The pictures are being selected and centered but not sized.

 

[SkipVought]

Did you not read the questions I asked above. What are this value at the time that it does not run as expected?

So if you restart Excel, then it WILL do what you want?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[rceddy]

Thank you for you're help.

I ran and reran the code using the watch and msgboxes with the variables. The SendVar worked fine but the wdObjRec seemed to be the problem. I finally took the Word object out of the individual macro and declared it Public. That seemed to solve the problem. Quite honestly I'm not sure what was the exact problem since that didn't work the first couple of time until I removed some unneeded lines used for testing. Anyway, it is working now. I do appreciate your time. It is so nice to have a place to get suggestions, help and pointed in the right direction.

 

[rceddy]

I finally figured out the solution to this problem.

For anyone with the same problem:
InchesToPoints Method was not preceded by WdObjRec object variable. It ran the first time and created a reference that was not released and cause an error on additional runs.

Original Code

WdObjRec.Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
            
            With WdObjRec.ActiveDocument.PageSetup
                .TopMargin = InchesToPoints(0.6)
                .BottomMargin = InchesToPoints(0.6)
                .LeftMargin = InchesToPoints(0.7)
                .RightMargin = InchesToPoints(0.7)
                .Gutter = InchesToPoints(0)
                .HeaderDistance = InchesToPoints(0)
                .FooterDistance = InchesToPoints(0)
                .PageWidth = InchesToPoints(8.5)
                .PageHeight = InchesToPoints(11)
            End With

Should be:

WdObjRec.Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
            
            With WdObjRec.ActiveDocument.PageSetup
                .TopMargin = WdObjRec.InchesToPoints(0.6)
                .BottomMargin = WdObjRec.InchesToPoints(0.6)
                .LeftMargin = WdObjRec.InchesToPoints(0.7)
                .RightMargin = WdObjRec.InchesToPoints(0.7)
                .Gutter = WdObjRec.InchesToPoints(0)
                .HeaderDistance = WdObjRec.InchesToPoints(0)
                .FooterDistance = WdObjRec.InchesToPoints(0)
                .PageWidth = WdObjRec.InchesToPoints(8.5)
                .PageHeight = WdObjRec.InchesToPoints(11)
            End With

 

[fumei]

badda-bing, badda-boom. Fully qualified objects.

BTW: I would suggest also making a Document object, rather than always using ActiveDocument.

faq219-2884

Gerry
My paintings and sculpture