Pasting range from Excel to Word 'original size' varies dramatically between computers

[derekpegg]

I have some Excel VBA that creates a Word document and inserts a number of tables (named ranges) into the document and then sizes them as percentage of their original size. I cannot use a fixed size as the individual ranges are often modified within Excel to fit the contents etc.

What I have found is that the size of all these tables in the Word document on one particular computer is significantly smaller than all other computers I have run this procedure on.

I tried to do the operation manually by selecting a known range of cells in Excel and then pasting (as an Enhanced Metafile picture) into Word. When I right click and look at the properties in Word, the table has an 'original size' far smaller (about 50% smaller) than on all other computers I have tested this on. This means, when the image is scaled to eg. 75%, it remains far too small.

I have researched and there appears to be a lot of discussion about printer drivers (for the default printer) affecting he size that cells may be pasted into other Office applications form Excel, but am unable to get anything working in relation to this after changing the default printer and updating drivers.

Both machines running Office 2010.

Any help or direction is very much appreciated.

Thanks for reading.

 

[derekpegg]

I case anyone is interested, I think I have resolved this and made the code more stable.

Essentially I used '.width' instead or '.scalewidth' to scale the table in Word from Excel.

To overcome the issue that tables have a dynamic size as rows and columns are auto-fitted, I first took the entire width of each table in Excel and used a formula to determine the size of the final table required in the Word doc. This had the added benefit that oversized tables could be shrunk slightly to a maximum size within Word. An extract of the code I am now using:

        Dim pointer As Double
        pointer = 28.3464567

            'RESIZE RANGE

            appWd.Selection.MoveLeft Unit:=wdCharacter, count:=1, extend:=wdExtend
            appWd.Selection.InlineShapes(1).LockAspectRatio = msoFalse

                    If (Selection.Width / 35) * pointer > 481.9 Then 'If Adviser synopsis is greater than max allowed

                    Dim Actual3 As Double
                    Dim Big3 As Double
                    Dim Proportion3 As Double
                    Dim Reducer3 As Double
                    
                    Actual3 = ((Selection.Width / 35) * pointer)
                    Big3 = Actual3 - 481.9
                    Proportion3 = Big3 / Actual3
                    Reducer3 = 1 - Proportion3
                    
                    appWd.Selection.InlineShapes(1).Width = 481.9
                    appWd.Selection.InlineShapes(1).Height = ((Selection.Height / 35) * pointer) * Reducer3
                
                Else
                    appWd.Selection.InlineShapes(1).Width = (Selection.Width / 35) * pointer
                    appWd.Selection.InlineShapes(1).Height = (Selection.Height / 35) * pointer
                End If