Thema Datum  Von Nutzer Rating
Antwort
21.02.2009 18:13:43 werner
NotSolved
Blau Aw:Progress bar während eine Kopiervorgangs anzeig
22.02.2009 10:09:09 Holger
NotSolved

Ansicht des Beitrags:
Von:
Holger
Datum:
22.02.2009 10:09:09
Views:
1080
Rating: Antwort:
  Ja
Thema:
Aw:Progress bar während eine Kopiervorgangs anzeig
Hallo werner,
offenbar sollen sowohl deine UserForm, eine Sub und das Steuerelement(?) PB1 heißen. Das geht nicht!
Wenn ich deinen Code richtig verstehe, werden im Case 0 in Abhängigkeit von B7 und I7 jeweils zwei kurze Kopiervorgänge angestoßen, also insgesamt 4. Nun weiß ich nicht, was bei den anderen Fällen der ComboBox passieren soll. Wenn das auch so kurze Kopiervorgänge sind, sei die Frage gestattet, ob sich der Aufwand wirklich lohnt. Aber es geht ja vielleicht um das Prinzip.
Ich gehe von immer 4 Kopiervorgängen aus. Wenn ich deinen Ansatz richtig verstehe, willst du mit Label1-3 dir selbst einen ProgressBar basteln. Es gibt aber bereits ein fertiges Steuerelement Microsoft ProgressBar, das du im Menü Extras – Zus. Steuerelement der Werkzeugleiste zuführen kannst.
Nun werden bei dem gewählten Copy-Befehl alle Zellen der Range kopiert, bevor das Programm wieder etwas anderes machen kann, z.B. den ProgressBar aktualisieren. Zumindest bei Case 0 kannst du also nur nach jedem Kopiervorgang aktualisieren, z.B.:

PB_Wert=0
Schrittweite=25
Select Case ComboBox1.Value
Case 0
If Range("B7").Value = "B" Then
Worksheets("Mappe1").Range("B8:C18").Copy _
Destination:=Worksheets("Mappe2").Range("B8")
PB_Wert =PB_Wert+Schrittweite
Progessbar1.value= PB_Wert
repaint
Worksheets("Mappe1").Range("d8:g11").Copy _
Destination:=Worksheets("Mappe2").Range("d8")
PB_Wert =PB_Wert+Schrittweite
Progessbar1.value= PB_Wert
repaint
End If


Wenn du eine höhere Auflösung im Progressbar haben möchtest, kannst du z.B. mit einer For-Next-Schleife die Zellen einzeln kopieren:
Worksheets("Mappe2").Cells(Zeile2,Spalte2)= Worksheets("Mappe1").Cells(Zeile1,Spalte1)
Aus der Anzahl der zu kopierenden Zellen kannst du Schrittweite festlegen. Dieses Verfahren dauert aber länger.
Gruß
Holger


werner schrieb am 21.02.2009 18:13:43:

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

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
21.02.2009 18:13:43 werner
NotSolved
Blau Aw:Progress bar während eine Kopiervorgangs anzeig
22.02.2009 10:09:09 Holger
NotSolved