während das nach folgende Makro läuft möchte ich gern in der Userform (frmSuchen), die eingeblendet bleibt, eine Microsoft_ProgressBar (Fortschrittsbalken in %) mit laufen lassen. Die Progressbar soll in die sichtbare Userform integriert werden. Habe schon einiges probiert klappt aber nicht.
Für jede Hilfe dankbar
Peter
Private Sub btnDatensatz_suchen_Click()
Sheets("Berechnung").Select
Range("B1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Mldg = "Es wurden " & _
Selection.Rows.Count & " Datensätze eingelesen."
Stil = vbOKOnly + vbInformation + vbDefaultButton2
Title = "Datensatzsuchprogramm"
Kontext = 1000
Ergebnis = MsgBox(Mldg, Stil, Title, Help, Kontext)
Else
For i = 1 To Zähler
MsgBox "Teil " & i & " der Markierung enthält " & _
Selection.Areas(i).Rows.Count & " Zeilen."
Next i
End If
Sheets("Berechnung").Select
Ergebnis = MsgBox("Datensätze werden gesucht", Stil, "Datensatzsuchprogramm", Help, Kontext)
'Fügt die Berechnungsformeln ein
Application.Cells(1, 6).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;3;FALSCH)"
Application.Cells(1, 7).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;4;FALSCH)"
Application.Cells(1, 8).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;5;FALSCH)"
Application.Cells(1, 9).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;6;FALSCH)"
'Legt die Anzahl der zusuchenden Datensätze fest
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 6), Cells(1, 9))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 6), Cells(Selection.Rows.Count, 9))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
Range("B1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Else
For i = 1 To Zähler
Next i
End If
Application.Cells(1, 1).Formula = "1"
Application.Cells(2, 1).Formula = "2"
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 1), Cells(2, 1))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 1), Cells(Selection.Rows.Count, 1))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
'Fügt die Berechnungsformeln ein
Application.Cells(1, 11).Formula = "=SVERWEIS(Port_Neu;Zurü_Suchbereich;2;FALSCH)"
Application.Cells(1, 12).Formula = "=SVERWEIS(Port_Neu;Zurü_Suchbereich;3;FALSCH)"
Application.Cells(1, 13).Formula = "=SVERWEIS(Port_Neu;Zurü_Suchbereich;4;FALSCH)"
'Legt die Anzahl der zusuchenden Datensätze fest
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 11), Cells(1, 13))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 11), Cells(Selection.Rows.Count, 13))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
'Fügt die Berechnungsformeln ein
Application.Cells(1, 14).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_T_DSL;2;FALSCH)"
Application.Cells(1, 15).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_T_DSL;3;FALSCH)"
'Legt die Anzahl der zusuchenden Datensätze fest
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 14), Cells(1, 15))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 14), Cells(Selection.Rows.Count, 15))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
Range("B1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Else
For i = 1 To Zähler
Next i
End If
'Kopiert nur die Werte in die Umschalteliste
Range("Umschaltliste").Select
Selection.Copy
Sheets("Umschalteliste").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Berechnung").Select
Application.CutCopyMode = False
Sheets("Umschalteliste").Select
ActiveCell.Select
Sheets("Umschalteliste").Select
frmSuchen.Hide
Sheets("Umschalteliste").Copy
Mldg = "Liste wurde erfolgreich" & _
" erstellt "
Stil = vbOKOnly + vbInformation + vbDefaultButton1
Title = "Datensatzsuchprogramm"
Kontext = 1000
Ergebnis = MsgBox(Mldg, Stil, Title, Help, Kontext)
'schließt das Programm ohne die Daten zuspeichern
Windows("Datensatzsuchprogramm.XLS").Activate
ActiveWorkbook.Close SaveChanges:=False
End Sub