Gruppe
Dialog
Problem
Wenn ich mehrere Arbeitsblätter auswähle und den Druckbefehl gebe wird mir in der Kopfzeile als Gesamtzahl der Blätter die Gesamtzahl der Druckseiten aller ausgewählten Arbeitsblätter ausgegeben. Wie kann ich das auf die Seiten des jeweiligen Arbeitsblattes beschränken?
StandardModule: basMain
Sub PrintSheets()
Dim frmNew As Object
Dim wks As Worksheet
Dim chb As MSForms.CheckBox
Dim cmd As MSForms.CommandButton
Dim arr() As String
Dim iCounter As Integer, iDrive As Integer
Dim iTop As Integer
Dim sCode As String
Application.VBE.MainWindow.Visible = False
On Error Resume Next
Set frmNew = ThisWorkbook.VBProject.VBComponents("frmWks")
If Err = 0 Then GoTo ERRORHANDLER
On Error GoTo 0
Set frmNew = ThisWorkbook.VBProject.VBComponents.Add(3)
iTop = 5
For Each wks In Worksheets
Set chb = frmNew.Designer.Controls.Add("forms.CheckBox.1")
With chb
.Top = iTop
.Left = 5
.Width = 100
.Caption = "Blatt " & wks.Name
End With
iTop = iTop + 20
Next wks
Set cmd = frmNew.Designer.Controls.Add("forms.CommandButton.1")
With cmd
.Top = iTop
.Left = 5
.Width = 100
.Height = 25
.Caption = "OK"
.Name = "cmdOK"
End With
iTop = iTop + 30
Set cmd = frmNew.Designer.Controls.Add("forms.CommandButton.1")
With cmd
.Top = iTop
.Left = 5
.Width = 100
.Height = 25
.Caption = "Abbrechen"
.Name = "cmdCancel"
End With
With frmNew
.Properties("Width") = 118
.Properties("Height") = iTop + 50
.Properties("Caption") = "Arbeitsblätter"
.Properties("Name") = "frmWks"
End With
sCode = "Private Sub cmdCancel_Click" & vbLf
sCode = sCode & " Unload Me" & vbLf
sCode = sCode & "End Sub" & vbLf & vbLf
sCode = sCode & "Private Sub cmdOK_Click" & vbLf
sCode = sCode & " Dim arr() as String" & vbLf
sCode = sCode & " Dim iArr as Integer" & vbLf
sCode = sCode & " Dim iCounter As Integer" & vbLf
sCode = sCode & " For iCounter = 1 to " & Worksheets.Count & vbLf
sCode = sCode & " If Controls(""CheckBox"" & iCounter).Value"
sCode = sCode & " = True Then" & vbLf
sCode = sCode & " iArr = iArr + 1" & vbLf
sCode = sCode & " Redim Preserve arr(1 to iArr)" & vbLf
sCode = sCode & " arr(iArr) = Worksheets(iCounter).Name" & vbLf
sCode = sCode & " End If" & vbLf
sCode = sCode & " Next iCounter" & vbLf
sCode = sCode & " If iArr > 0 Then" & vbLf
sCode = sCode & " Unload Me" & vbLf
sCode = sCode & " For iCounter = 1 to iArr" & vbLf
sCode = sCode & " Worksheets(arr(iCounter)).PrintPreview" & vbLf
sCode = sCode & " Next iCounter" & vbLf
sCode = sCode & " Else" & vbLf
sCode = sCode & " Unload Me" & vbLf
sCode = sCode & " End If" & vbLf
sCode = sCode & "End Sub" & vbLf
ThisWorkbook.VBProject.VBComponents("frmWks").CodeModule.AddFromString sCode
ERRORHANDLER:
VBA.UserForms.Add(frmNew.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(frmNew.Name)
Set frmNew = Nothing
Exit Sub
End Sub