beim schließen Problem

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
msg = MsgBox("Bitte Formular nur über die vorgesehene Schaltfläche beenden")
If CloseMode  1 Then
Cancel = 1
End If
End Sub

Private Sub cmdOK_Click()
Dim lngI As Long, lngNext As Long, lngRow As Long, lngCol As Long
Dim rng1 As Range, rng2 As Range, rng As Range
With Sheets("Versuchseinrichtungen")
For lngI = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lngI) Then
If rng1 Is Nothing Then
Set rng1 = .Cells(lngI + 1, 1)
Else
Set rng1 = Union(rng1, .Cells(lngI + 1, 1))
End If
End If
.Cells(lngI + 1, 2).Value = Me.ListBox1.Selected(lngI)  'neue Zeile
Next
End With
With Sheets("Versuchsarten")
For lngI = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(lngI) Then
If rng2 Is Nothing Then
Set rng2 = .Cells(lngI + 1, 1)
Else
Set rng2 = Union(rng2, .Cells(lngI + 1, 1))
End If
End If
.Cells(lngI + 1, 2).Value = Me.ListBox2.Selected(lngI)  'neue Zeile
Next
End With
With Sheets("Drucken")
.Range("A48:AJ55").ClearContents
If Not rng1 Is Nothing Then
lngRow = 49
lngCol = 1
For Each rng In rng1
.Cells(lngRow, lngCol) = rng.Value
lngRow = lngRow + 1
If lngRow > 55 Then
lngRow = 49
lngCol = lngCol + 12
End If
Next
End If
.Range("A39:AJ45").ClearContents
If Not rng2 Is Nothing Then
lngRow = 39
lngCol = 1
For Each rng In rng2
.Cells(lngRow, lngCol) = rng.Value
lngRow = lngRow + 1
If lngRow > 45 Then
lngRow = 39
lngCol = lngCol + 10
End If
Next
End If
Unload Me
End With
Set rng1 = Nothing
Set rng2 = Nothing
Worksheets("Drucken").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"U:\Groups\BuT-Auftragsdaten\Auftragsdaten\" & Range("Drucken!BJ9").Value & ".pdf",  _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Dim strDateiname As String
Dim strAntwort As String
strDateiname = Range("Drucken!BJ9").Value & ".xlsm"
ActiveWorkbook.SaveAs ("U:\Groups\BuT-Auftragsdaten\Auftragsdaten\" & strDateiname)
ThisWorkbook.Saved = True
Application.Quit
End Sub