Print sheet after update shapes/images

[kiredw]

Hello,

Is it possible to print a worksheet after the shapes are ready? At the moment I use a timer. The worksheets needs to run on multiple machines. So I need to set the timer to the slowest machine.

I dont like to let the people wait for nothing and when the machine got some latency the image can be wrong.

I created multiple layers of shapes on a sheets. All the layers together will form one perfect picture. The Shapes have a formula to get the image from an other sheets with the correct pictures. I created a print function to print all the sheets. Now I use a timer. So when the function starts printing the sheets with the pictures will wait for 30 seconds. Is there a function to check if all the shapes are loaded correctly before the print action starts?


Printfunction to create an correct array with the sheets

Sub printbon()
    Application.ScreenUpdating = False
    showsheets
    
    Dim sheetbonname(6) As Variant
    
    sheetbonname(0) = "Werkorder"
    sheetbonname(1) = "Spuiterijbon"
    sheetbonname(2) = "Magazijnbon"
    sheetbonname(3) = "Meeleverbon"
    sheetbonname(4) = "Verspanningbon"
    sheetbonname(5) = "Paneelbon"
    
    If (Worksheets("Invoerscherm").Range("I34") <> "" And Worksheets("Invoerscherm").Range("I34") <> "Geen") Then
        sheetbonname(6) = "Regenkapbon"
    Else
        sheetbonname(6) = ""
    End If
    Call printsheet(sheetbonname)
    hidesheets
    Application.ScreenUpdating = True
End Sub

Print function

Sub printsheet(sheetname As Variant)
Dim i As Integer
Dim oldsheet As String
oldsheet = ActiveSheet.Name
    For i = 0 To (UBound(sheetname))
        Dim rng As Range
        Dim row As Range
        Dim cell As Range
        Dim count As Integer
        If (sheetname(i) <> "") Then
        count = Worksheets(sheetname(i)).UsedRange.Rows.count
                
        Set rng = Worksheets(sheetname(i)).Range("G1:G" & count)
        If sheetname(i) = "Magazijnbon" Or sheetname(i) = "Verspanningbon" Or sheetname(i) = "Meeleverbon" Then
            If sheetname(i) = "Meeleverbon" Or sheetname(i) = "Verspanningbon" Then
                Set rng = Worksheets(sheetname(i)).Range("H1:H" & count)
            End If
            
            For Each row In rng.Rows
                If row.value = "0" Then
                    row.Hidden = True
                End If
            Next row
        End If
        
        If sheetname(i) = "Werkorder" Or sheetname(i) = "Paneelbon" Then
            Dim sheet As Worksheet
            Set sheet = Worksheets(sheetname(i))
            
            setimage "", sheet
            WaitFor (30)
            sheets(sheetname(i)).PrintOut Copies:=1
            setimage "hide", sheet
        ElseIf sheetname(i) = "Spuiterijbon" Then
            If sheets(sheetname(i)).Range("B9").value <> "0" Then
            sheets(sheetname(i)).PrintOut Copies:=1
            End If
        ElseIf sheetname(i) = "Meeleverbon" Or sheetname(i) = "Verspanningbon" Or sheetname(i) = "Magazijnbon" Then
            sheets(sheetname(i)).PrintOut Copies:=1
        ElseIf (sheetname(i) = "Regenkap") Then
            If (Worksheets("Invoerscherm").Range("I34") = "Regenkap") Then
                sheets(sheetname(i)).Range("A1:AN32").PrintOut Copies:=1
            ElseIf (Worksheets("Invoerscherm").Range("I34") = "Insteekkap") Then
                sheets(sheetname(i)).Range("O1:AB32").PrintOut Copies:=1
            End If
        End If
        
        For Each row In rng.Rows
            If row.value = "0" Then
                row.Hidden = False
            End If
        Next row
    End If
    Next i
    Worksheets(oldsheet).Activate
End Sub

Waitfunction

Sub WaitFor(NumOfSeconds As Long)
Dim SngSec As Long
SngSec = Timer + NumOfSeconds
Do While Timer < SngSec
DoEvents
Loop
End Sub

Function to create the image

Function setimage(action As String, Optional sheets As Worksheet)
    Dim Shp As Shape
    Dim wrksheets As Worksheet
    
    Dim width
    Dim height
    Dim left
    Dim top
    
    If sheets Is Nothing Then
        Set wrksheets = ActiveSheet
    Else
        Set wrksheets = sheets
    End If
    
    
    If wrksheets.Name = "Werkorder" Then
        width = 215.1413
        height = 254.4843
        left = 288.75
        top = 245.25
    Else
        width = 215.1413
        height = 251.433
        left = 220
        top = 200
    End If
    
    For Each Shp In wrksheets.Shapes
        If action = "hide" Then
            With Shp
                   .DrawingObject.Formula = ""
            End With
            
        Else
            If Shp.Name = "deurbasis" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            ElseIf Shp.Name = "handvat" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
             ElseIf Shp.Name = "deurnaamstel" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            ElseIf Shp.Name = "handvatstel" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            ElseIf Shp.Name = "ondergeleiding" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            ElseIf Shp.Name = "ondergeleiding_maatvoering" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
           ElseIf Shp.Name = "ophangpunten" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            ElseIf Shp.Name = "raamsectie" Then
                With Shp
                    .width = width
                    .height = height
                    .left = left
                    .top = top
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            ElseIf Shp.Name = "schuifrichting" Then
                With Shp
                    .width = 94.5
                    .height = 46.87504
                    .left = 324.0001
                    .top = 493.8749
                    .DrawingObject.Formula = "=tek_" & Shp.Name
                End With
            End If
        End If
    
    Next
End Function

I search a lot on internet and I cannot find the perfect solution. I hope someone can help me or give me a hint.

Thanks in advance.

[kiredw]

uhmmm