Condividi:        

Popolamento ListBox Excel 2003

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Popolamento ListBox Excel 2003

Postdi papiriof » 08/02/13 19:10

Con questo codice adattato da me (su un file trovato in rete) ogni volta che cambio
il contenuto del TextBox2(situato su un'userform) nel sottostante ListBox1 vengono
riportate tutti i record della colonna B(di un elenco posto su un foglio denominato "Database") che iniziano per la prima lettera che digito ,es: digito "p" e la ListBox1 si popola di stringhe che iniziano per "p" tipo
Pico
Panda
Pacopo
Pippo baudo
Popolo
Ora, se nel TextBox2 digito "pi" adesso come adesso la ListBox1 si popola delle stringhe
Pico
Pippo baudo
Mentre io vorrei che allorquando digitassi "po" la ListBox1 si popolasse con
Pacopo
Pippo baudo
Popolo
ovvero con quelle stringhe che in qualche modo contengano "po" indipendentemente se questa frazione di stringa sia all'inizio , in mezzo o alla fine QUESTO IL CODICE della FORM:
Codice: Seleziona tutto
Public trovato As String
Public datum As New Collection
Dim Index As Integer    'indice di riga pulsante e modifica listbox




Private Sub CommandButton1_Click()    'Aggiungi
    Dim Lig As Long
   
    If OptionButton3 = True Then
        With Sheets("Database")
            Lig = .Range("A65536").End(xlUp).Row + 1
            .Cells(Lig, 1).Value = CDbl(TextBox1)    'Num di catalogo
            .Cells(Lig, 2).Value = TextBox2    'Descrizione
            .Cells(Lig, 3).Value = TextBox3    'Primo giorno Emissione(data)
            .Cells(Lig, 4).Value = CDate(TextBox4)    'data fine validità
            .Cells(Lig - 1, 5).Copy Destination:=.Cells(Lig, 5)    'gg di validit copia la formula
            .Cells(Lig, 6).Value = CDbl(TextBox6) 'valore di un singolo esemplare
            .Cells(Lig, 7).Value = CDbl(TextBox7)    'Esmplari posseduti
            .Cells(Lig - 1, 8).Copy Destination:=.Cells(Lig, 8)    'Valore totale record Copio la formula
            .Columns("A:H").AutoFit
        End With
    End If

    Me.OptionButton3 = False

    CancellaConTrol Me

End Sub

Private Sub CommandButton2_Click()    'Modifica

    If OptionButton4 = True Then
        With Sheets("Database")
            .Cells(Index, 1).Value = CDbl(TextBox1)
            .Cells(Index, 2).Value = TextBox2
            .Cells(Index, 3).Value = TextBox3
            .Cells(Index, 4).Value = CDate(TextBox4)
            '.Cells(Index, 5).Value = TextBox5 ''''''''''''''''''''cancella la formula
            .Cells(Index, 6).Value = CDbl(TextBox6)
            .Cells(Index, 7).Value = CDbl(TextBox7)
            .Cells(Index - 1, 8).Copy Destination:=.Cells(Index, 8) ' copio la formula
            .Columns("A:H").AutoFit
        End With
    End If

    Me.OptionButton4 = False
    CancellaConTrol Me
    TextBox5.Text = Sheets("Database").Cells(Index, 5).Value

End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub





Private Sub OptionButton3_Click()    'Aggiungi

    If OptionButton3 = True Then
        Me.CommandButton1.Enabled = True
        Me.CommandButton2.Enabled = False
    End If
End Sub

Private Sub OptionButton4_Click()    'Modifica

    If OptionButton4 = True Then
        Me.CommandButton1.Enabled = False
        Me.CommandButton2.Enabled = True

    End If
End Sub

Private Sub TextBox2_Change()


    Dim intervallo As Range, Cell As Range
    Dim Ricerca As String, Indirizzo As String
    Dim Riga As Variant
    Dim C As Range
    Dim data As New Collection
    Dim I As Integer

    'If trovato <> "" Then Exit Sub
    If datum.Count > 0 Then
        For I = 1 To datum.Count
            datum.Remove 1
        Next
    End If

    Ricerca = TextBox2.Value
    Riga = Range("B" & "65536").End(xlUp).Row
    Set intervallo = Range("B1:B" & Riga)
    ListBox1.Clear
    With intervallo
        Set C = .Find(Ricerca)
        If Not C Is Nothing Then
            Indirizzo = C.Address
            Do
                On Error Resume Next
                If UCase(Ricerca) = UCase(Left(C, Len(Ricerca))) Then

                    data.Add Item:=C.Value & " " & C.Offset(0, 1)
                    datum.Add C.Row    'Format(C.Row, "0000")
                End If
                On Error GoTo 0
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> Indirizzo
        End If
    End With
    'If data.Count = 1 Then TextBox2.Value = data(1): Exit Sub
    For I = 1 To data.Count
        ListBox1.AddItem data(I)
        ListBox1.List(ListBox1.ListCount - 1, 1) = datum(I)
    Next I
End Sub
Private Sub UserForm_Initialize()

    Dim Intestazione As Integer, Lig As Long, Plg As Range
    Dim Zc As Integer, I As Integer
    'For Intestazione = 1 To 9
    '   If Intestazione <> 6 Then
    '     Me.Controls("label" & Intestazione).Caption = Cells(1, Intestazione)
    ' End If
    ' Next Intestazione
    For Zc = 1 To 8
        Select Case Zc
        Case 1 To 8
            I = I + 1
            Me.Controls("label" & Zc).Caption = Cells(1, Zc)
        End Select
    Next Zc


    Me.CommandButton1.Enabled = False    'Aggiungi
    Me.CommandButton2.Enabled = False    'Modifica
   
    Me.OptionButton3 = False    'Aggiungi
    Me.OptionButton4 = False    'Modifica
    TextBox5.Enabled = False    'Valore unitario

    With Me.ListBox1
        .ColumnCount = 2
        .ColumnWidths = "90;0"    'largeur
    End With
 Me.TextBox9 = Worksheets("Database").Range("NumFra")
 Me.TextBox10 = Worksheets("Database").Range("ValFra")

End Sub

Private Sub ListBox1_Change()

    If ListBox1.ListIndex = -1 Then Exit Sub

    Index = ListBox1.List(ListBox1.ListIndex, 1)

    If Index > 0 Then
        With Sheets("Database")
            TextBox1.Text = .Cells(Index, 1)
            TextBox2.Text = .Cells(Index, 2)
            TextBox3.Text = .Cells(Index, 3)
            TextBox4.Text = .Cells(Index, 4)
            TextBox5.Text = .Cells(Index, 5)
            TextBox6.Text = .Cells(Index, 6)
            TextBox7.Text = .Cells(Index, 7)
            TextBox8.Text = .Cells(Index, 8)
     
           
        End With
    End If

End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim I As Integer

    trovato = ""
    For I = 1 To 8
        Me.Controls("TextBox" & I).Text = ""
    Next I


    For I = 1 To datum.Count
        datum.Remove 1
    Next

   
    Me.OptionButton3 = False
    Me.OptionButton4 = False

    Me.CommandButton1.Enabled = False    'Aggiungi
    Me.CommandButton2.Enabled = False    'Modifica
End Sub

QUESTO IL CODICE DEL MODULO
Codice: Seleziona tutto
Public Sub CancellaConTrol(ByRef UForm As UserForm)
    Dim Ctrl As Control
    'può essere utilizzato per tutti UserForms
    'nome: CancellaConTrol Me
    For Each Ctrl In UForm.Controls
        If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = vbNullString
        If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = vbNullString

    Next
    Set Ctrl = Nothing
End Sub
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Sponsor
 

Re: Popolamento ListBox Excel 2003

Postdi Flash30005 » 08/02/13 21:59

In TextBox2_Change
devi modificare la condizione da così
Codice: Seleziona tutto
If UCase(Ricerca) = UCase(Left(C, Len(Ricerca))) Then

a
così
Codice: Seleziona tutto
If Len(Replace(UCase(C), UCase(Ricerca), "")) <> Len(UCase(C)) Then


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Popolamento ListBox Excel 2003

Postdi papiriof » 09/02/13 07:17

GRAZIE Flash Funziona tutto!!!!
e quello che più importaho imprato cose nuove (per me)
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Popolamento ListBox Excel 2003

Postdi papiriof » 01/03/13 10:22

Riprendo questo argomento per chiedere se fosse possibile inserire nell'userform (di cui al codice indicato sopra ) un'immagine che nelle intenzioni mi riportasse l'immagine appunto il cui nome è indicato nel Texbox1 .
Allo scopo ho messo nell'USF " image1 " (per adesso non funzionante) è remmato (perchè nel contesto dell'USF non so dove e come piazzare) il segente codice:
Codice: Seleziona tutto
'    With Image1
'.Picture = LoadPicture([b]ThisWorkbook.Path [/b]& "\" & TextBox1 & ".jgp")     'da adattare VEDI PERCORSO
'.PictureAlignment = fmPictureAlignmentCenter ' centraggio dell'immagine nel controllo
' .PictureSizeMode = fmPictureSizeModeZoom ' impostare la scala dell'immagine nel controllo
'End With
'e nell'inizialize sempre remmato 'Me.TextBox1 = LoadPicture(ThisWorkbook.Path & "\" & TextBox1 & ".jgp")

Il file di excel l'ho messo nella stessa cartella dove risiedono le immagini le quali hanno gli stessi nomi che hanno sulla Colonna A del foglio e che corrispondono al Textbox1 . Mi aspetterei che ogni volta che cambia il textbo1 (dove risiede il nome dell'immagine) mi apparrisse l'immgine di cui al nome del textbox1.
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Popolamento ListBox Excel 2003

Postdi Anthony47 » 01/03/13 13:58

Potresti partire da una macro di TextBox_Change, del tipo
Codice: Seleziona tutto
Private Sub TextBox1_Change()
myPath = ThisWorkbook.Path & "\"
If Dir(myPath & TextBox1.Text & ".jpg") <> "" Then
    UserForm1.Picture = LoadPicture(myPath & TextBox1.Text & ".jpg")
    UserForm1.PictureSizeMode = fmPictureSizeModeZoom
    'altre proprieta' della Picture
End If
End Sub

L' istruzione nel codice di userform_initialize ha senso solo se nella stessa initialize Textbox viene compilato con un valore iniziale.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Popolamento ListBox Excel 2003

Postdi papiriof » 01/03/13 16:04

Anthony47 ha scritto:Potresti partire da una macro di TextBox_Change, del tipo
Codice: Seleziona tutto
Private Sub TextBox1_Change()
myPath = ThisWorkbook.Path & "\"
If Dir(myPath & TextBox1.Text & ".jpg") <> "" Then
    UserForm1.Picture = LoadPicture(myPath & TextBox1.Text & ".jpg")
    UserForm1.PictureSizeMode = fmPictureSizeModeZoom
    'altre proprieta' della Picture
End If
End Sub

L' istruzione nel codice di userform_initialize ha senso solo se nella stessa initialize Textbox viene compilato con un valore iniziale.

Ciao

Ci quasi stiamo nel senso che come suggerito si bloccava a: "UserForm1.Picture = LoadPicture(myPath & TextBox1.Text & ".jpg")" perciò l'ho cambiata in questo modo:
Codice: Seleziona tutto
Private Sub TextBox1_Change()
myPath = ThisWorkbook.Path & "\"
If Dir(myPath & TextBox1.Text & ".jpg") <> "" Then
    USFMio_.Picture = LoadPicture(myPath & TextBox1.Text & ".jpg")
    USFMio_.PictureSizeMode = fmPictureSizeModeZoom
    'altre proprieta' della Picture
End If
End Sub

in quanto l'userform l'avevo nominato "USFMio_" in questa maniera adesso gira ma l'immagine ENOrmemente ingrandita e sgranata(occupa tutta la parte centrale del corpo dell'USF) non si va a piazzare nell' image1
Non oso toccare niente attualmente il codice dell'USFMio_ è questo :
Codice: Seleziona tutto
Public trovato As String
Public datum As New Collection
Dim Index As Integer    'indice di riga pulsante e modifica listbox

Private Sub TextBox1_Change()
myPath = ThisWorkbook.Path & "\"
If Dir(myPath & TextBox1.Text & ".jpg") <> "" Then
    USFMio_.Picture = LoadPicture(myPath & TextBox1.Text & ".jpg")
    USFMio_.PictureSizeMode = fmPictureSizeModeZoom
    'altre proprieta' della Picture
End If
End Sub

Private Sub TextBox6_Change()
 TextBox6 = Replace(TextBox6, ".", ",")
 End Sub


Private Sub CommandButton1_Click()    'Aggiungi
    Dim Lig As Long
   
    If OptionButton3 = True Then
        With Sheets("Database")
            Lig = .Range("A65536").End(xlUp).Row + 1
            .Cells(Lig, 1).Value = CDbl(TextBox1)    'Num di catalogo
            .Cells(Lig, 2).Value = TextBox2    'Descrizione
            .Cells(Lig, 3).Value = CDate(TextBox3)    'Primo giorno Emissione(data)
            .Cells(Lig, 4).Value = CDate(TextBox4)    'data fine validità
            .Cells(Lig - 1, 5).Copy Destination:=.Cells(Lig, 5)    'gg di validit copia la formula
            .Cells(Lig, 6).Value = CDbl(TextBox6) 'valore di un singolo esemplare
            .Cells(Lig, 7).Value = CDbl(TextBox7)    'Esmplari posseduti
            .Cells(Lig - 1, 8).Copy Destination:=.Cells(Lig, 8)    'Valore totale record Copio la formula
            .Columns("A:H").AutoFit
        End With
    End If

    Me.OptionButton3 = False

    CancellaConTrol Me

End Sub

Private Sub CommandButton2_Click()    'Modifica

    If OptionButton4 = True Then
        With Sheets("Database")
            .Cells(Index, 1).Value = CDbl(TextBox1)
            .Cells(Index, 2).Value = TextBox2
            .Cells(Lig, 3).Value = CDate(TextBox3)    'Primo giorno Emissione(data)
            .Cells(Index, 4).Value = CDate(TextBox4)
            '.Cells(Index, 5).Value = TextBox5 ''''''''''''''''''''cancella la formula
            .Cells(Index, 6).Value = CDbl(TextBox6)
            .Cells(Index, 7).Value = CDbl(TextBox7)
            .Cells(Index - 1, 8).Copy Destination:=.Cells(Index, 8) ' copio la formula
            .Columns("A:H").AutoFit
        End With
    End If

    Me.OptionButton4 = False
    CancellaConTrol Me
    TextBox5.Text = Sheets("Database").Cells(Index, 5).Value

End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub





Private Sub OptionButton3_Click()    'Aggiungi

    If OptionButton3 = True Then
        Me.CommandButton1.Enabled = True
        Me.CommandButton2.Enabled = False
    End If
End Sub

Private Sub OptionButton4_Click()    'Modifica

    If OptionButton4 = True Then
        Me.CommandButton1.Enabled = False
        Me.CommandButton2.Enabled = True

    End If
End Sub

Private Sub TextBox2_Change()


    Dim intervallo As Range, Cell As Range
    Dim Ricerca As String, Indirizzo As String
    Dim Riga As Variant
    Dim C As Range
    Dim data As New Collection
    Dim I As Integer

    'If trovato <> "" Then Exit Sub
    If datum.Count > 0 Then
        For I = 1 To datum.Count
            datum.Remove 1
        Next
    End If

    Ricerca = TextBox2.Value
    Riga = Range("B" & "65536").End(xlUp).Row
    Set intervallo = Range("B1:B" & Riga)
    ListBox1.Clear
    With intervallo
        Set C = .Find(Ricerca)
        If Not C Is Nothing Then
            Indirizzo = C.Address
            Do
                On Error Resume Next
             
If Len(Replace(UCase(C), UCase(Ricerca), "")) <> Len(UCase(C)) Then ' ricerca nel corpo della stringa

                    data.Add Item:=C.Value & " " & C.Offset(0, 1)
                    datum.Add C.Row    'Format(C.Row, "0000")
                End If
                On Error GoTo 0
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> Indirizzo
        End If
    End With
    'If data.Count = 1 Then TextBox2.Value = data(1): Exit Sub
    For I = 1 To data.Count
        ListBox1.AddItem data(I)
        ListBox1.List(ListBox1.ListCount - 1, 1) = datum(I)
    Next I

End Sub
Private Sub UserForm_Initialize()

    Dim Intestazione As Integer, Lig As Long, Plg As Range
    Dim Zc As Integer, I As Integer
   
    For Zc = 1 To 8
        Select Case Zc
        Case 1 To 8
            I = I + 1
            Me.Controls("label" & Zc).Caption = Cells(1, Zc)
        End Select
    Next Zc


    Me.CommandButton1.Enabled = False    'Aggiungi
    Me.CommandButton2.Enabled = False    'Modifica
   
    Me.OptionButton3 = False    'Aggiungi
    Me.OptionButton4 = False    'Modifica
    TextBox5.Enabled = False    'Valore unitario

    With Me.ListBox1
        .ColumnCount = 2
        .ColumnWidths = "90;0"    'largeur
    End With
 Me.TextBox9 = Worksheets("Database").Range("NumFra")
 Me.TextBox10 = Worksheets("Database").Range("ValFra")

End Sub

Private Sub ListBox1_Change()

    If ListBox1.ListIndex = -1 Then Exit Sub

    Index = ListBox1.List(ListBox1.ListIndex, 1)

    If Index > 0 Then
        With Sheets("Database")
            TextBox1.Text = .Cells(Index, 1)
            TextBox2.Text = .Cells(Index, 2)
            TextBox3.Text = .Cells(Index, 3)
            TextBox4.Text = .Cells(Index, 4)
            TextBox5.Text = .Cells(Index, 5)
            TextBox6.Text = .Cells(Index, 6)
            TextBox7.Text = .Cells(Index, 7)
            TextBox8.Text = .Cells(Index, 8)
     
           
        End With
    End If

End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim I As Integer

    trovato = ""
    For I = 1 To 8
        Me.Controls("TextBox" & I).Text = ""
    Next I


    For I = 1 To datum.Count
        datum.Remove 1
    Next

   
    Me.OptionButton3 = False
    Me.OptionButton4 = False

    Me.CommandButton1.Enabled = False    'Aggiungi
    Me.CommandButton2.Enabled = False    'Modifica
End Sub

Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Popolamento ListBox Excel 2003

Postdi papiriof » 01/03/13 16:47

Avvo detto che non avrei toccato niente ma(GRAZIE ALLA TUA DRITTA :D :D :D ) con un po di ragionamento ci sono riuscito !!!
Adesso funziona con questo codice
Codice: Seleziona tutto
Private Sub TextBox1_Change()

With Image1
myPath = ThisWorkbook.Path & "\"
If Dir(myPath & TextBox1.Text & ".jpg") <> "" Then
    Image1.Picture = LoadPicture(myPath & TextBox1.Text & ".jpg")
    Image1.PictureSizeMode = fmPictureSizeModeZoom
    'altre proprieta' della Picture
End If
End With
End Sub

ANCORA GRAZIE ANTONY!!!
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Popolamento ListBox Excel 2003

Postdi Anthony47 » 02/03/13 00:06

Non avevo proprio capito che per Image1 intendessi il "controllo Image", pensavo a una immagine da inserire sullo sfondo della userform.

Alla prossima...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Popolamento ListBox Excel 2003":


Chi c’è in linea

Visitano il forum: Nessuno e 103 ospiti