' Fortschritsanzeige
Private Sub ShowProgress(picProgress As PictureBox, _
  ByVal Value As Long, _
  ByVal Min As Long, _
  ByVal Max As Long, _
  Optional ByVal bShowProzent As Boolean = True)
 
  Dim pWidth As Long
  Dim intProz As Integer
  Dim strProz As String
 
  ' Farben
  Const progBackColor = vbRed
  Const progForeColor = vbBlack
  Const progForeColorHighlight = vbWhite
 
  ' Plausibilitätsprüfungen
  If Value < Min Then Value = Min
  If Value > Max Then Value = Max
 
  ' Prozentwert ausrechnen
  If Max > 0 Then
    intProz = Int(Value / Max * 100 + 0.5)
  Else
    intProz = 100
  End If
 
  With picProgress
    ' Prüfen, ob AutoReadraw=True
    If .AutoRedraw = False Then .AutoRedraw = True
 
    ' Inhalt löschen
    picProgress.Cls
 
    If Value > 0 Then
 
      ' Balkenbreite
      pWidth = .ScaleWidth / 100 * intProz
 
      ' Balken anzeigen
      picProgress.Line (0, 0)-(pWidth, .ScaleHeight), _
        progBackColor, BF
 
      ' Prozentanzeige
      If bShowProzent Then
        strProz = CStr(intProz) & " %"
        .CurrentX = (.ScaleWidth - .TextWidth(strProz)) / 2
        .CurrentY = (.ScaleHeight - .TextHeight(strProz)) / 2
 
        ' Vordergrundfarbe
        If pWidth >= .CurrentX Then
          .ForeColor = progForeColorHighlight
        Else
          .ForeColor = progForeColor
        End If
 
        picProgress.Print strProz
      End If
    End If
  End With
End Sub

MsgBox ("Die Datensätze werden jetzt eingelesen und einzelnen Gruppen" & _
  "zugeteilt." & vbCrLf & vbCrLf & "Dieser Vorgang kann BIS ZU 2 MINUTEN" & _
  "dauern!" & vbCrLf & vbCrLf & "Bei Problemen wenden sie sich bitte an Hr." & _
  "Huemer Boris - IT / DW 62 / Boris.Huemer@aluplast.at"), vbOKOnly, ("Wichtige" & _
  "Information!!! Bitte lesen!!!")
    frmStatus.Picture2.Visible = False
    frmStatus.Picture1.Visible = True
   ' anbinden der Datenbank für Gruppe FERTIGUNG
  Dim DB As Database ' deklaration für Database
  Dim Rs As Recordset ' Deklaration für Recordset
 frmStatus.Picture2.Visible = True
    frmStatus.Picture1.Visible = False
  Set DB = DBEngine.OpenDatabase("m:\edv\extern\kontinv\Kont_Inv.mdb")
  ' datenbankanbindung wird angezapft
  Set Rs = DB.OpenRecordset("SELECT artikel FROM a_fert") ' Informationen über 
  ' die Abrfage werden deklariert
 
  If Rs.RecordCount > 0 Then ' Füllen der Listbox durch While Schleife
   ' Status-Form anzeigen
    Dim lngMax As Long
    Dim lngAkt As Long
    frmStatus.Picture2.Visible = True
    frmStatus.Picture1.Visible = False
    frmStatus.Picture2.Visible = False
    frmStatus.Picture1.Visible = True
    lngAkt = 0: lngMax = Rs.RecordCount
frmStatus.picProgress.Refresh
 frmStatus.Refresh
    Load frmStatus
    ShowProgress frmStatus.picProgress, 0, 0, 0
 
    frmStatus.Show
    DoEvents
 
    While Not Rs.EOF
 frmStatus.picProgress.Refresh
 frmStatus.Refresh
     list_fertigung.AddItem Rs(0)
      Rs.MoveNext ' Wechseln zum nächsten artikel
 
    Wend
  End If
 frmStatus.picProgress.Refresh
 frmStatus.Refresh
  Rs.Close
  DB.Close
  Set DB = Nothing

cu
Bris

"640 KB Ram sind mehr als irgendein Programm jemals ben?tigen wird."
- (Bill Gates - 1981)