Hallo wer kann helfen….???
Ich möchte während des (über die Combobox1 gestarteten) Kopiervorgangs eine Progress bar (PB1) anzeigen. Diese PB soll den Fortschritt des Kopiervorgangs anzeigen.
Private Sub ComboBox1_Change()
PB1.Show
Select Case ComboBox1.Value
Case 0
If Range("B7").Value = "B" Then
Worksheets("Mappe1").Range("B8:C18").Copy _
Destination:=Worksheets("Mappe2").Range("B8")
Worksheets("Mappe1").Range("d8:g11").Copy _
Destination:=Worksheets("Mappe2").Range("d8")
End If
If Range("B7").Value = "C" Then
Worksheets("Mappe1").Range("B8:C18").Copy _
Destination:=Worksheets("Mappe2").Range("I8")
Worksheets("Mappe1").Range("d8:g11").Copy _
Destination:=Worksheets("Mappe2").Range("k8")
End If
If Range("B7").Value = "D" Then
Worksheets("Mappe1").Range("B8:C18").Copy _
Destination:=Worksheets("Mappe2").Range("P8")
Worksheets("Mappe1").Range("d8:g11").Copy _
Destination:=Worksheets("Mappe2").Range("r8")
End If
If Range("B7").Value = "E" Then
Worksheets("Mappe1").Range("B8:C18").Copy _
Destination:=Worksheets("Mappe2").Range("W8")
Worksheets("Mappe1").Range("d8:g11").Copy _
Destination:=Worksheets("Mappe2").Range("y8")
End If
If Range("I7").Value = "B" Then
Worksheets("Mappe1").Range("I8:J18").Copy _
Destination:=Worksheets("Mappe2").Range("B8")
Worksheets("Mappe1").Range("k8:N11").Copy _
Destination:=Worksheets("Mappe2").Range("d8")
End If
If Range("I7").Value = "C" Then
worksheets("Mappe1").Range("I8:J18").Copy _
Destination:=Worksheets("Mappe2").Range("I8")
Worksheets("Mappe1").Range("k8:N11").Copy _
Destination:=Worksheets("Mappe2").Range("k8")
End If
If Range("I7").Value = "D" Then
Worksheets("Mappe1").Range("I8:J18").Copy _
Destination:=Worksheets("Mappe2").Range("P8")
Worksheets("Mappe1").Range("k8:N11").Copy _
Destination:=Worksheets("Mappe2").Range("r8")
End If
If Range("I7").Value = "E" Then
Worksheets("Mappe1").Range("I8:J18").Copy _
Destination:=Worksheets("Mappe2").Range("W8")
Worksheets("Mappe1").Range("k8:N11").Copy _
Destination:=Worksheets("Mappe2").Range("y8")
End If
Case 1…
Case 2…
Case 3…
End Select
End Sub
Option Explicit
Public SW As Long
Dim Schritt As Double
Dim Länge As Double
Dim i As Long
Sub PB1()
SW = 50 'Schrittweite festlegen
Länge = 0
Schritt = PB1.Label1.Width / SW 'Schrittbreite pro Aktualisierung
For i = 30 To SW
Cells(i, 1) = "Zeile " & i
Cells(i, 1).Interior.ColorIndex = 6
Länge = Länge + Schritt
PB1.Label2.Width = Länge
PB1.Label3.Caption = Format(i / SW, "0 %")
DoEvents
Next
Application.Wait (Now + TimeValue("0:00:2")) ' Zeit vor dem Unload
Unload PB1
End Sub
Danke
Werner |