User Form -Casella di Riepilogo e barra di scorrimento verticale-

Question

Buon giorno,

vorrei poter "adeguare" lo scorrimento della casella lungo la barra di scorrimento in funzione del numero degli elementi della casella di  Riepilogo , ovvero fare in modo che la casella di scorrimento della barra verticale sia più scorrevole possibile con il minimo di List Box1.list=lista e meno scorrevole con il massimo di lista.

Vorrei anche poter risolvere un altro aspetto correlato alla barra di scorrimento verticale .Se seleziono un nominativo posto al centro della casella di Riepilogo e nel mio caso premo tasto di conferma con reinializzazione dello UserForm  accade che tutta la lista scorre verso il basso e il nominativo lo ritrovo al bordo inferiore del riepilogo.

Potreste darmi qualche utile suggerimento ? 

Private Sub UserForm_Initialize()

Dim lista(3000, 3) As String

Dim i, y As Integer

Sheets("fogliodilavoro").Select

y = 10

       For i = 0 To 3000

           y = y + 1

           lista(i, 0) = cells(y, 1)

           lista(i, 1) = cells(y, 2)

           lista(i, 2) = cells(y, 3)

           lista(i, 3) = cells(y, 4)

              If cells(y, 2) = "" Then

                 i = 3000

              Else: End If

       Next i

    ListBox1.List = lista

    ListBox1.ColumnCount = 4

    ListBox1.ListIndex = 0

End Sub

Private Sub ListBox1_Click()

Dim unità, cond As String

Dim a, r As Integer

 r = ListBox1.ListIndex

 If r = -1 Then

    r = 0

 Else: End If

 a = r + 11

 cells(7, 2) = a

 cond = cells(a, 2)

 unità = cells(a, 3)

End Sub

Private Sub CommandButton1_Click()

'tasto conferma

Dim b As Integer

cells(cells(7, 2), 4) = "confermato"

b = ListBox1.ListIndex

UserForm_Initialize

ListBox1.ListIndex = b

End Sub

Answer 1

Ciao Joseph,

Mi fa piacere che tu abbia risolto il problema e ti ringrazio per il cortese riscontro.

Per chiudere questo thread,  e anche tuo thread precedente, vorrei chiederti gentilmente di contrassegnare la mia risposta come Risposta Preferita.

In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

===

Regards,

Norman

Answer 2

Ciao Joseph,

La re-inizializzazione era per me l'unico modo per visualizzare nel riepilogo ,al fianco del nominativo selezionato ,la scritta " confermato".

Prova a sostiuire

'=========>>

Option Explicit

Private SH As Worksheet

Private bFlag As Boolean

con:

'=========>>

Option Explicit

Private SH As Worksheet

Private bFlag As Boolean

Private RngDati As Range

Sostituisci anche

'--------->>

Private Sub cbConferma_Click()

    Dim Rng As Range

    Dim iVal As Long

    bFlag = True

    With SH

        Set Rng = .Cells(7, 2)

        iVal = Rng.Value

        If Not iVal = 0 Then

            .Cells(iVal, 4) = "confermato"

        End If

    End With

    With Me.ListBox1

        .TopIndex = .ListIndex

    End With

    bFlag = False

End Sub

'--------->>

con:

'--------->>

Private Sub cbConferma_Click()

    Dim Rng As Range

    Dim iVal As Long

    Dim Lrow As Long

    bFlag = True

    With SH

        Set Rng = .Cells(7, 2)

        iVal = Rng.Value

        If Not iVal = 0 Then

            .Cells(iVal, 4) = "confermato"

        End If

    End With

   Me.ListBox1.RowSource = RngDati.Address(External:=True)

    bFlag = False

End Sub

'--------->>

===

Regards,

Norman

Answer 3

Grazie Norman,

le soluzioni date  sono molto convincenti. Ho provato  i tuoi codici e funzionano alla perfezione, un po' difficoltosi da capire per le mie scarse conoscenze di programmazione. La re-inizializzazione era per me l'unico modo per visualizzare nel riepilogo ,al fianco del nominativo selezionato ,la scritta " confermato". La proprietà TopIndex l'avevo scartata perché mi spostava la posizione  in origine del nominativo selezionato al primo record visibile. Le istruzione " che non servono allo scopo" sono un di più che avrei dovuto togliere perché non erano attinenti ai quesiti posti. Ringrazio ancora per  l'attenzione rivolatami.

Josephcelo

Answer 4

Ciao Joseph,

vorrei poter "adeguare" lo scorrimento della casella lungo la barra di scorrimento in funzione del numero degli elementi della casella di  Riepilogo , ovvero fare in modo che la casella di scorrimento della barra verticale sia più scorrevole possibile con il minimo di List Box1.list=lista e meno scorrevole con il massimo di lista.

Mi spiace ma non ho capito molto!

Se stai facendo riferimento al fatto che il controllo ListBox scorrerà verso il basso fino al record 3000, anche se ci sono (ad esempio) solo 1000 record, credo che la soluzione migliore sia quella di limitare la dimensione del controllo ListBox al numero di record da caricare. A questo proposito vedi il codice qui sotto.

Per facilitare lo scorrimento, si potrebbe facilmente aggiungere pulsanti per scorrere, diciamo, 50 e 100 record:

Vorrei anche poter risolvere un altro aspetto correlato alla barra di scorrimento verticale .Se seleziono un nominativo posto al centro della casella di Riepilogo e nel mio caso premo tasto di conferma con reinializzazione dello UserForm  accade che tutta la lista scorre verso il basso e il nominativo lo ritrovo al bordo inferiore del riepilogo. 

A meno che non vi è una ragione non divulgata, non capisco perché vorresti ri-inizializzare la Userform. Ad ogni modo, credo che potresti sfruttare la proprietà TopIndex del controllo ListBox per assicurarsi che il record selezionato diventa sempre il primo record visibile.

Quindi, forse prova qualcosa del genere:

'=========>>

Option Explicit

Private SH As Worksheet

Private bFlag As Boolean

Private Const iScrollPiccolo As Long = 50 '<<=== Modifica

Private Const iScrollGrande As Long = 100 '<<=== Modifica

'--------->>

Private Sub UserForm_Initialize()

    Dim WB As Workbook

    Dim Rng As Range

    Dim lista(3000, 3) As String

    Dim LRow As Long

    Const sFoglio As String = "Foglio1"                            '<<=== Modifica

    Const iPrimaRigaDati As Long = 10

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = .Range("B" & iPrimaRigaDati).End(xlDown).Row

        Set Rng = .Range("A" & iPrimaRigaDati). _

                  Resize(LRow - iPrimaRigaDati + 1, 4)

    End With

    bFlag = True

    With Me

        With .ListBox1

            .ColumnHeads = True

            .RowSource = Rng.Address(external:=True)

            .ColumnCount = 4

            .ListIndex = 0

            .ColumnWidths = "60;60;60"                '<<=== Modifica

        End With

        With .cbConferma

            .Caption = "Conferma"

             .ForeColor = vbGreen

             .Font.Bold = True

            .AutoSize = True

        End With

        With .cbScrollAvantiPiccolo

            .Caption = ">> " & iScrollPiccolo

                 .ForeColor = vbGreen

            .AutoSize = True

        End With

        With .cbScrollAvantiGrande

            .Caption = ">> " & iScrollGrande

            .ForeColor = vbGreen

            .AutoSize = True

        End With

        With .cbScrollInDietroPiccolo

            .Caption = "<< " & iScrollPiccolo

                 .ForeColor = vbRed

            .AutoSize = True

        End With

        With .cbScrollInDietroGrande

            .Caption = "<< " & iScrollGrande

            .ForeColor = vbRed

            .AutoSize = True

        End With

    End With

    bFlag = False

End Sub

'--------->>

Private Sub ListBox1_Click()

    Dim unità, cond As String

    Dim a As Long, r As Long

    If bFlag Then

        Exit Sub

    End If

    With Me.ListBox1

        If .ListIndex = -1 Then

            r = 0

        Else

            r = .ListIndex

        End If

        a = r + 11

        SH.Cells(7, 2).Value = a

        cond = Cells(a, 2).Value  '// Non serve alcuno scopo??

        unità = Cells(a, 3).Value  '// Non serve alcuno scopo??

    End With

End Sub

'--------->>

Private Sub cbConferma_Click()

    Dim Rng As Range

    Dim iVal As Long

    bFlag = True

    With SH

        Set Rng = .Cells(7, 2)

        iVal = Rng.Value

        If Not iVal = 0 Then

            .Cells(iVal, 4) = "confermato"

        End If

    End With

    With Me.ListBox1

        .TopIndex = .ListIndex

    End With

    bFlag = False

End Sub

'--------->>

Private Sub cbScrollAvantiPiccolo_Click()

    Call FastScroll(50)

End Sub

'--------->>

Private Sub cbScrollAvantiGrande_Click()

    Call FastScroll(100)

End Sub

'--------->>

Private Sub cbScrollInDietroPiccolo_Click()

    Call FastScroll(-50)

End Sub

'--------->>

Private Sub cbScrollInDietroGrande_Click()

    Call FastScroll(-100)

End Sub

'--------->>

Private Sub FastScroll(iScroll)

    Dim iCtr As Long

    Dim bValid As Boolean

    bFlag = True

    With Me.ListBox1

        iCtr = .ListIndex + iScroll

        If iScroll > 0 Then

            bValid = iCtr <= .ListCount

        Else

            bValid = iCtr >= 0

        End If

        If bValid Then

            .ListIndex = .ListIndex + iScroll

        End If

    End With

    bFlag = False

End Sub

'<<=========

Approfitterei per chiederti gentilmente di contrassegnare la mia risposta nel tuo thread precedente come Risposta. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

===

Regards,

Norman