kiredw
01-16-2014, 04:07 AM
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.
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.