Funktionelles kopieren von MultiPage-Pages
28.02.2025 09:42:51
crabalina
ich bin hier neu und ich hoffe mir kann jemand helfen, ich stecke gerade ziemlich fest.
ich möchte einen Vorgang verschönern.
Wir führen eine Liste in der wir aufschreiben, welche geänderten Dokumente wir wem und wieso geschickt haben. Durch eine Änderung bekommen mehrere Personen eine Mitteilung, dies wird in der Liste hinterlegt und danach noch zusätzlich als Word-Doc genauer beschrieben und dann verschickt.
Ich habe ein Userform erstellt, damit es einfacher/eleganter wird.
Ich hoffe durch das Bild wird es etwas klarer.
Wie man sieht, habe ich momentan schon alle pages angelegt und durch die Checkboxauswahl werden die pages sichtbar bzw. unsichtbar.
Allerdings finde ich das keine elegante Lösung, vor allem weil ich dann auch alle textboxen einzeln ansprechen muss.
Vorher hatte ich das bei Auswahl einer Checkbox die erste page kopiert wird. Damit kam ich aber auch nicht weiter.
Bei "Transferdokumente" habe ich eine listbox die mir alle Dokumente aus einem Ordner anzeigt, es soll aber auch manuell angegeben werden können.
Ich möchte eigentlich das bei jeder neuen Page das auch so ist, aber irgendwie kriege ich das alles so nicht hin, bzw. es wird ein riesig langer code.
Vielleicht hat hier jemand eine bessere Lösung für das Problem.
Private Sub Checkbox1_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox2_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox3_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox4_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox5_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox6_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox7_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox8_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub Checkbox9_Click()
If UserForm2.CheckBox1.Value = True Then
MultiPage1.Pages(0).Visible = True
Else
MultiPage1.Pages(0).Visible = False
End If
End Sub
Private Sub CheckBox10_Click()
If Me.CheckBox10.Value = True Then
Me.TextBox9.Visible = True
Me.TextBox9.Enabled = True
Me.ListBox1.Visible = False
Me.ListBox1.Enabled = False
Else
Me.TextBox9.Visible = False
Me.TextBox9.Enabled = False
Me.ListBox1.Visible = True
Me.ListBox1.Enabled = True
End If
End Sub
Private Sub ComboBox1_Change()
Dim pfad As String
On Error GoTo errorhandling
Me.ListBox1.Clear
If Dir("TESTPFAD" & Trim(UserForm2.ComboBox1.Text)) > "" Then
pfad = "TESTPFAD" & Trim(UserForm2.ComboBox1.Text)
Else
pfad = "TESTPFAD" & Trim(UserForm2.ComboBox1.Text)
End If
Call dateienauslesen(pfad)
Call unterordnerauslesen(pfad)
errorhandling:
If Err.Number > 0 Then
Call errorhandling
End If
End Sub
Private Sub CommandButton1_Click()
Unload UserForm2
End Sub
Private Sub UserForm_Initialize()
Dim lz As Integer
On Error GoTo errorhandling
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
UserForm2.Caption = Cells(lz, 1)
GetSubFolders "TESTPFAD" 'PFAD einfügen
GetSubFolders "TESTPFAD" 'PFAD einfügen
errorhandling:
If Err.Number > 0 Then
Call errorhandling
End If
End Sub
Private Sub CommandButton2_Click()
Dim i, lz As Integer
Dim cb As Control
Dim s As String
On Error GoTo errorhandling
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For Each cb In Me.Controls
If cb = True Then
cb = cb + 1
Cells(lz, 2) = UserForm2.ComboBox1.Value
Cells(lz, 3) = UserForm2.TextBox2.Value
Cells(lz, 4) = UserForm2.TextBox3.Value
' Cells(lz, 7) = Revision
' Cells(lz, 8) = Datum
'...
End If
Next
errorhandling:
If Err.Number > 0 Then
Call errorhandling
End If
End Sub
'FUNKTIONEN
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call HookListBoxScroll(Me, Me.ComboBox1)
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call HookListBoxScroll(Me, Me.ListBox1)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call UnhookListBoxScroll
End Sub
Function GetSubFolders(pfad)
Dim fso, FO, FU, f
On Error GoTo errorhandling
Set fso = CreateObject("Scripting.FileSystemObject")
Set FO = fso.GetFolder(pfad)
Set FU = FO.SubFolders
On Error Resume Next
For Each f In FU
UserForm2.ComboBox1.AddItem f.name
Next
errorhandling:
If Err.Number > 0 Then
Call errorhandling
End If
End Function
Function dateienauslesen(pfad)
Dim fso As New FileSystemObject
Dim Datei As File
On Error GoTo errorhandling
For Each Datei In fso.GetFolder(pfad).Files
If Datei.Type = "Adobe Acrobat-Dokument" Then
UserForm2.ListBox1.AddItem Datei.name
End If
Next Datei
errorhandling:
If Err.Number > 0 Then
Call errorhandling
End If
End Function
Function unterordnerauslesen(pfad)
Dim fso As New FileSystemObject
Dim unterordner As Folder
On Error GoTo errorhandling
For Each unterordner In fso.GetFolder(pfad).SubFolders
Call dateienauslesen(unterordner.Path)
Call unterordnerauslesen(unterordner.Path)
Next unterordner
errorhandling:
If Err.Number > 0 Then
Call errorhandling
End If
End Function
Function errorhandling()
MsgBox ("Error: " & Err.Number & vbNewLine & Err.Description)
End Function
Ich hoffe da blickt jemand durch
LG
crabalina
Anzeige