Newsgroup: it.comp.lang.visual-basic
Titolo: [VBA] Creare una "PROGRESS BAR"

Ho scritto una piccola applicazione VBA tramite l'editor
Visual Basic presente in Word97.
Questa applicazione effettua una ricerca su migliaia di files,
divisi in varie directory tramite il metodo FileSearch.
La ricerca impiega parecchio tempo e la UserForm che utilizzo
sembra bloccata (anche se non lo e' veramente). Come posso
visualizzare una progress bar oppure un messaggio animato
che dica che la ricerca e' in corso?
Grazie in anticipo per l'aiuto.
Stefano
P.S.
Allego qui sotto il codice che sto utilizzando:
Dim Parola As String
Sub CercaParole(miaParola As String)
    Dim i, Risposta, Posizione As Integer
    Dim fs As Application
    Dim appoggio As String
    Dim myPath As String
    Dim mySearch As String
    Dim myResults() As String 'creazione di un array dinamico
    myPath = "\\ANDROMEDA\Seduteprecedenti\2003"
    Set fs = Application
    MsgBox ("Cerco per " & miaParola)
    With fs.FileSearch
        .NewSearch
        .LookIn = myPath
        .SearchSubFolders = True
        '.TextOrProperty = miaParola 'con questo metodo funziona
    With fs.FileSearch.PropertyTests
        .Add Name:="Testo o proprietą",
Condition:=msoConditionIncludesPhrase, _
            Value:=miaParola, Connector:=msoConnectorOr
    End With
        If .Execute() > 0 Then 'qui l'applicazione sembra bloccarsi
            Risposta = MsgBox("Trovati " & .FoundFiles.Count & " file.",
vbInformation)
            ReDim myResults(1 To .FoundFiles.Count)
            For i = 1 To .FoundFiles.Count
                myResults(i) = .FoundFiles(i)
                Posizione = InStr(myResults(i), "2003")
                appoggio = Mid(myResults(i), Posizione)
                ListBox1.AddItem (i & " - " & appoggio)
                appoggio = ""
            Next i
        Else
            ReDim myResults(1)
            myResults(1) = "La ricerca ha avuto esito negativo!"
            ListBox1.AddItem ("0" & " - " & myResults(1))
        End If
    End With
    Parola = ""
End Sub

Non che usi vba ... ma mi pare che tu possa refenziare
controlli esterni. Quindi ho trovi un controllino gratuito
che to lo installi, referenzi e usi ...
alternativamente, ritengo assai più semplice, senza volere
una progress bar troppo complicata con un'oggetto picture
e qualche decina di righe di codice penso che tu possa ottenere
la tua progress bar.
Il problema grosso lo avrai quando dovrai per forza di cosa
dare un valore massimo di scansione in modo da disegnare
l'area azzurra (o il colore che ti piace) per far sapere a che
punto è arrivata la scansione.
Ma anche qui, se cerchi su google in passato è stato trattato
l'argomento.
Ciao
Andrea

che dica che la ricerca e' in corso?
[snipped]
Progress bar:
inserisci nella form un controllo picture e un controllo image
controllo image.visible = false
controllo image.picture = immagine bmp di uno step della progress bar
dentro il ciclo con paintpicture disegni l'immagine sopra il controllo
picture
Risultato: hai una progress bar velocissima senza oggetti di terzi
Saluti
Aggiungo un mio vecchio programma fatto in vb3 16 bit che ho
convertito oggi e a cui ho tolto tutte le cose che non servono per il
nostro controllo
Devi solamente aggiungere a image1 una bmp con il colore che ti
interessa (una barra)
Dai in pasto "nome file" un qualsiasi file di testo
Naturalmente il mio modulo è sicuramente migliorabile e "si vedono " i
molti  peccati di gioventù.
Saluti
---- inizio
VERSION 5.00
Begin VB.Form frmUMov 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Importazione Movimenti"
   ClientHeight    =   2688
   ClientLeft      =   1968
   ClientTop       =   2088
   ClientWidth     =   6012
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2688
   ScaleWidth      =   6012
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "Uscita"
      Height          =   300
      Left            =   4920
      TabIndex        =   3
      Top             =   2280
      Width           =   855
   End
   Begin VB.CommandButton cmdGo 
      Caption         =   "Esegui"
      Default         =   -1  'True
      Height          =   300
      Left            =   120
      TabIndex        =   2
      Top             =   2280
      Width           =   855
   End
   Begin VB.Frame Frame1 
      Caption         =   "Selezione"
      Height          =   2055
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   5775
      Begin VB.TextBox txtFile 
         Height          =   285
         Left            =   960
         TabIndex        =   1
         Top             =   240
         Width           =   4695
      End
      Begin VB.PictureBox Picture1 
         Height          =   255
         Left            =   1320
         ScaleHeight     =   204
         ScaleWidth      =   4284
         TabIndex        =   5
         Top             =   1680
         Visible         =   0   'False
         Width           =   4335
      End
      Begin VB.Label Label1 
         Caption         =   "File "
         Height          =   255
         Left            =   360
         TabIndex        =   6
         Top             =   240
         Width           =   375
      End
      Begin VB.Label lblPerce 
         Height          =   255
         Left            =   720
         TabIndex        =   4
         Top             =   1680
         Width           =   495
      End
   End
   Begin VB.Image Image1 
      Height          =   240
      Left            =   3000
      Picture         =   "frmumov.frx":0000
      Top             =   2280
      Visible         =   0   'False
      Width           =   96
   End
End
Attribute VB_Name = "frmUMov"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sCha As String
Dim nErrori As Integer
Const csTipo As String = "IMPMOV"
Dim vLeft, vWidth
Private Sub cmdExit_Click()
    Unload Me
End Sub
Private Sub cmdGo_Click()
    Dim lRiga As Long
    Dim k As Long
    Dim vSize As Long
    Dim vCurr As Long
    Dim vprec As Long
    Dim vProg As Long
    Dim nRiga As Long
    Dim j, x
    nErrori = 0
    Picture1.Refresh
    vCurr = 0
    vProg = 0
    vprec = 0
    lblPerce.Caption = ""
    Let lRiga = 0
    If MsgBox("Conferma", vbYesNo + vbQuestion) = vbYes Then
        Picture1.Visible = True
        frmUMov.MousePointer = vbHourglass
        Open txtFile.Text For Input Lock Write As #1
        vSize = LOF(1)
        Do Until EOF(1)
            Line Input #1, sCha
            vCurr = vCurr + Len(sCha) + 2
            If CInt((vCurr / vSize) * 100) > 100 Then
                lblPerce.Caption = "100%"
            Else
                lblPerce.Caption = CStr(CInt((vCurr / vSize) * 100)) +
"%"
            End If
            lblPerce.Refresh
            If Picture1.Width > vSize Then
                x = CInt((vCurr - vprec) * (Picture1.Width / vSize /
(Image1.Width + 10)) + 0.5)
            Else
                x = CInt((vCurr - vprec) * (Picture1.Width / vSize /
(Image1.Width + 10)) / 2)
            End If
            If x = 0 And lblPerce.Caption = "100%" Then x = 1
            k = 0
            For j = 1 To x
                Picture1.PaintPicture Image1.Picture, vProg, 5
                vProg = vProg + Image1.Width + 10
                k = 1
            Next j
            If k = 1 Then vprec = vCurr
            Loop
            Close #1
            Me.MousePointer = vbNormal
            lblPerce.Caption = "100%"
            MsgBox "Operazione conclusa con " + Format(nErrori, "##0")
+ " errori", vbOKOnly
            Picture1.Visible = False
            lblPerce.Caption = ""
    End If
End Sub
---fine
=======================================================================
Se mi vuoi scrivere togli le maiuscole
Sveltolampo 
ctenizaMALED...@hotmail.com
=======================================================================