Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88054

How to write robust code that will work on slower machines for resizing large numbers of shapes in Excel VBA

$
0
0

I am working on an Excel application that creates reports from a inventory of data. This application is intended to be distributed to a large number of staff with potentially older/slower computers. As part of generating reports, a large number of shapes (80ish) are to be resized and re-positioned. I am running into problems with only some computers where the shapes are not doing what the code is dictating.

I am able to step through the code with consistent successful results regardless of the host computer. I've tried adding DoEvents and Workbook.RefreshAll statements with varying degrees of success. I also am unlinking any linked pictures.

The x1, x2, y1, y2 are points (from xWhereAmI and yWhereAmI) obtained from selecting the mid point of a cell location saved in a table dictating reference for the shape position. I can confirm that these are correct points regardless of screen resolution.

'Resize and formatting

   '(x1,y1)-----------------(x2)
   '   |
   '   |
   '   |
   '   |
   '   |
   '   |
   '  (y2)

i = 0
Set myRange = Codebackground.Range("pSOIRobjects")
For Each Pic In PSOIR.Shapes
     If Pic.Type = msoPicture Then
     'for rotated shapes
     If Pic.Rotation = 270 Then
            'x1
                myX1 = GlobalOp.yWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 3))
            'x2
                myX2 = GlobalOp.yWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 4))
            'y1
                myY1 = GlobalOp.xWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 3))
            'y2
                myY2 = GlobalOp.xWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 5))

            'resize and position
                Pic.LockAspectRatio = msoFalse
                Pic.Width = myX1 - myX2
                Pic.Height = myY2 - myY1
                Pic.Left = 0
                Pic.IncrementLeft myY1 - (Pic.Width - Pic.Height) / 2
                Pic.Top = myX2 + (Pic.Width - Pic.Height) / 2

        'for unrotated shapes
            Else
            'x1
                myX1 = GlobalOp.xWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 3))
            'x2
                myX2 = GlobalOp.xWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 4))
            'y1
                myY1 = GlobalOp.yWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 3))
            'y2
                myY2 = GlobalOp.yWhereAmI(Application.WorksheetFunction.VLookup(Pic.name, myRange, 5))

                Pic.LockAspectRatio = msoFalse
                Pic.Width = myX2 - myX1
                Pic.Height = myY2 - myY1
                Pic.Left = myX1
                Pic.Top = myY1
            End If
        End If
        i = i + 1
        Application.StatusBar = "Formatting shape "& i
        DoEvents
    Next

x point function

Public Function xWhereAmI(myCell As String) As Double

Dim cell2find As String
Dim cellWidth As Double
Dim myRange As Range

cell2find = myCell
Set myRange = ThisWorkbook.Worksheets("PSOIR").Range(""& cell2find & "")
xWhereAmI = myRange.Left + (myRange.Width / 2)

End Function

y point function

Public Function yWhereAmI(myCell As String) As Double

Dim cell2find As String
Dim cellWidth As Double
Dim myRange As Range

cell2find = myCell
Set myRange = ThisWorkbook.Worksheets("PSOIR").Range(""& cell2find & "")

yWhereAmI = myRange.Top + (myRange.RowHeight / 2)

End Function

I expect the output to be shapes that are re-positioned and resized according to the x1, x2, y1, y2 values. However, the shapes seem to sometimes be in a lower position depending on what computer is used. On some computers the code runs flawlessly, however, on other computers the shapes are positioned incorrectly. Any thoughts or ideas are much appreciated!

I've tested this with over 10 computers now with mostly successful results. I think the problem arises in the lines where the shape size and position is manipulated. Strangely enough, on computers that the code doesn't run properly, even if DoEvent statements or Wait statements are added between the shape manipulation lines (.height, .width, .top, .left), the result is the same.

Does anyone have suggestions to make the code run slower?


Viewing all articles
Browse latest Browse all 88054

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>