AW: Das Makro hat Ulf erstellt, die ...
14.06.2023 13:09:52
Ulf
Hi Susi,
das Positionieren kann Probleme machen, deshalb:
ALT+F11, rechter Mausklick auf frmKopieren, Code anzeigen,unten steht:
Private Sub UserForm_Initialize()
On Local Error GoTo UserForm_InitializeERR
Dim Wb As Workbook
Dim wks As Worksheet
Dim strWb As String
Dim props As DocumentProperties
Dim p As DocumentProperty
For Each Wb In Excel.Workbooks
strWb = Wb.Name
If strWb > ActiveWorkbook.Name Then
If LCase(Left(strWb, 10)) = "hauptlager" Then
Me.lbMappen.AddItem Wb.Name
End If
End If
Next Wb
Set props = ThisWorkbook.CustomDocumentProperties
If props.Count > 0 Then
Me.Left = props.Item("PropLeft").Value
Me.Top = props.Item("PropTop").Value
If Me.Left + Me.Width > Application.Width Then
Me.Left = 0
End If
If Me.Top + Me.Height > Application.Height Then
Me.Top = 0
End If
Me.chkEgal.Value = props.Item("Egal").Value
Me.TextBox9.Text = props.Item("Vorschaubereich").Value
End If
UserForm_InitializeERR:
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim props As DocumentProperties
Dim p As DocumentProperty
Set props = ActiveWorkbook.CustomDocumentProperties
If props.Count = 0 Then
props.Add "propLeft", False, msoPropertyTypeString, Me.Left
props.Add "propTop", False, msoPropertyTypeString, Me.Top
props.Add "Vorschaubereich", False, msoPropertyTypeString, Me.TextBox9.Text
props.Add "Egal", False, msoPropertyTypeBoolean, Me.chkEgal.Value
Else
For Each p In props
If p.Name = "PropLeft" Then
p.Value = Me.Left
ElseIf p.Name = "PropTop" Then
p.Value = Me.Top
ElseIf p.Name = "Vorschaubereich" Then
p.Value = Me.TextBox9.Text
ElseIf p.Name = "Egal" Then
p.Value = Me.chkEgal.Value
End If
Next p
End If
End Sub
auskommentiert:
Private Sub UserForm_Initialize()
On Local Error GoTo UserForm_InitializeERR
Dim Wb As Workbook
Dim wks As Worksheet
Dim strWb As String
Dim props As DocumentProperties
Dim p As DocumentProperty
For Each Wb In Excel.Workbooks
strWb = Wb.Name
If strWb > ActiveWorkbook.Name Then
If LCase(Left(strWb, 10)) = "hauptlager" Then
Me.lbMappen.AddItem Wb.Name
End If
End If
Next Wb
Set props = ThisWorkbook.CustomDocumentProperties
If props.Count > 0 Then
' Me.Left = props.Item("PropLeft").Value
' Me.Top = props.Item("PropTop").Value
If Me.Left + Me.Width > Application.Width Then
' Me.Left = 0
End If
If Me.Top + Me.Height > Application.Height Then
' Me.Top = 0
End If
Me.chkEgal.Value = props.Item("Egal").Value
Me.TextBox9.Text = props.Item("Vorschaubereich").Value
End If
UserForm_InitializeERR:
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim props As DocumentProperties
Dim p As DocumentProperty
Set props = ActiveWorkbook.CustomDocumentProperties
If props.Count = 0 Then
props.Add "propLeft", False, msoPropertyTypeString, Me.Left
props.Add "propTop", False, msoPropertyTypeString, Me.Top
props.Add "Vorschaubereich", False, msoPropertyTypeString, Me.TextBox9.Text
props.Add "Egal", False, msoPropertyTypeBoolean, Me.chkEgal.Value
Else
For Each p In props
If p.Name = "PropLeft" Then
' p.Value = Me.Left
ElseIf p.Name = "PropTop" Then
' p.Value = Me.Top
ElseIf p.Name = "Vorschaubereich" Then
p.Value = Me.TextBox9.Text
ElseIf p.Name = "Egal" Then
p.Value = Me.chkEgal.Value
End If
Next p
End If
End Sub
dann wird nicht mehr positioniert, der Vorschaubereich kann dann über den Desktop reichen !
Wenn das Formular sich wie ursprünglich zeigen soll:
frmKopieren rechter Mausklick, Objekt anzeigen, in den leeren Bereich rechtsklicken, Eigenschaften, dort StartupPosition auf bspw 3
hth
Gruß
Heiko
