[Risolto] Voci menu a discesa piccole e poco visibili

Si Gianfranco, funziona bene. Grazie.

Vorrei aggiungere una seconda sullo stesso foglio anche per capire come si fa, magari un'altra ancora nel caso volessi usare una combo su un altro foglio.

Grazie

Ciao

questa la macro che funziona (testata)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("B5:B1000")) Is Nothing Then
    Application.EnableEvents = False
UserForm1.Left = Cells(Target.Row, 3).Left + 20  'xxxxxxxxxx aggiunta
UserForm1.Top = Cells(Target.Row, 3).Top + 40    'xxxxxxxxxx aggiunta
    UserForm1.Show
    Application.EnableEvents = True

ElseIf Not Intersect(Target, Range("F5:F1000")) Is Nothing Then
    Application.EnableEvents = False
UserForm2.Left = Cells(Target.Row, 5).Left + 20  'xxxxxxxxxx aggiunta
UserForm2.Top = Cells(Target.Row, 5).Top + 40    'xxxxxxxxxx aggiunta
    UserForm2.Show
    Application.EnableEvents = True
  End If
End Sub

Trova la differenza con la tua.

Ciao,

Mario

Salve a tutti

Mi sono incaponito sull'uso della sola ComboBox (senza UserForm) che si posizioni a fianco della cella sulla quale si è fatto DoppioClick (anche se c'è stato uno scrolling)

Allego il file in cui basta fare doppio-clic su una cella degli intervalli B5:B54 oppure F5:F54

Questo il codice

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dati As String
Dim ur As Long
If Not Intersect(Target, Range("B5:B54")) Is Nothing Then
  ur = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
  dati = "Foglio2!B2:B" & ur
  ComboBox1.Left = Target.Offset(0, 1).Left + 10
  ComboBox1.Top = Target.Top
  ComboBox1.LinkedCell = Target.Address
  ComboBox1.ListFillRange = dati
  ComboBox1.Visible = True
ElseIf Not Intersect(Target, Range("F5:F54")) Is Nothing Then
  ur = Sheets(2).Cells(Rows.Count, 7).End(xlUp).Row
  dati = "Foglio2!G2:G" & ur
  ComboBox1.Left = Target.Offset(0, 1).Left + 10
  ComboBox1.Top = Target.Top
  ComboBox1.LinkedCell = Target.Address
  ComboBox1.ListFillRange = dati
  ComboBox1.Visible = True
Else
  ComboBox1.Visible = False
End If
End Sub

Private Sub ComboBox1_Click()
  ActiveCell = ComboBox1.Text
  ComboBox1.Visible = False
End Sub

C'è un piccolo inconveniente: il secondo doppio clic mostra la Combo con la dicitura precedente ma se si apre la lista con la freccetta si vedono i dati corretti. La fretta non mi ha permesso di approfondire.

Fai sapere. Ciao,

Mario

@mario

Io intanto provo con tutte e due le soluzioni. Ne approfitto per approfondire il funzionamento, bello sperimentare comunque soluzioni nuove e alternative.

Scusa la domanda che ti potrà sembrare banale. Ma basta quel codice visibile nella pagine del progetto per far apparire il combo o bisogna prima selezionare l'oggetto nel menu principale e posizionalo da qualche parte?

Venedo alla tua soluzione, sarebbe davvero quella forse più semplice. Vedo però ancora un paio di problemi. Il primo appunto lo hai già segnalato. Poi mi sono accorto che la combo non scompare se ci ripensi e non vuoi inserire nessuna voce. Ho aggiunto una riga bianca all'inizio per aggirare il problema e in ogni caso l'avrei comunque messa per avere come prima voce uno spazio bianco come nei miei file precedenti. Le liste e le tabelle inoltre non vengono riordinate in ordine alfabetico come nei precedenti progetti, ma a questo si può rimediare manualmente.

Grazie

@Gianfranco.

Sto lavorando anche sulla tua soluzione. Come ho già detto funziona alla grande.

MA vorrei essere in grado anche di capire alcuni passaggi in modo da poter replicare tutto su un altro progetto all'occorrenza. Ho provato cambiando ovviamente i riferimenti, ma mi da un errore e non capisco dove sia esattamente il problema.

Posso allegarti il nuovo file? Oltre a trovare l'errore sarebbe cosa ancora più gradita e utile se fossi in grado di spiegarmi dove sbaglio e cosa ho copiato male da un progetto all'altro.

Grazie

ciao

certo che puoi 

Buon pomeriggio ragazzi ( 😉 )

Ho lavorato sul file che avevo allegato e credo che la soluzione soddisfi le richieste.

Per far "scomparire" la combo se ci ripensi basta selezionare una cella fuori dagli intervalli segnalati.

Adesso mette anche in ordine alfabetico.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dati As String, x As Variant
Dim ur As Long
If Not Intersect(Target, Range("B5:B54")) Is Nothing Then
  ur = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
  dati = "Foglio2!B2:B" & ur
  x = PerCombo(Target, dati, "B2")
ElseIf Not Intersect(Target, Range("F5:F54")) Is Nothing Then
  ur = Sheets(2).Cells(Rows.Count, 7).End(xlUp).Row
  dati = "Foglio2!G2:G" & ur
  x = PerCombo(Target, dati, "G2")
Else
  ComboBox1.Visible = False
End If
Sheets(1).Cells(1, 1).Select
End Sub

Private Sub ComboBox1_Click()
  ComboBox1.Visible = False
End Sub

Function PerCombo(ByRef Target, ByVal dati As String, ByVal cel As String)
Dim rgn() As String
Application.ScreenUpdating = False
  ComboBox1.Left = Target.Offset(0, 1).Left + 6
  ComboBox1.Top = Target.Top
  ComboBox1.LinkedCell = Target.Address
  rgn = Split(dati, "!")
  With Sheets(2)
    .Select
    .Range(rgn(1)).Select
    Selection.Sort Key1:=.Range(cel), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End With
  Sheets(1).Select
  ComboBox1.ListFillRange = dati
  ComboBox1.Visible = True
Application.ScreenUpdating = True
End Function

Rivedete il tutto e fatemi sapere.

Ciao,

Mario

ciao

Marius

sarà una mia fissa 

ma è meglio che gestisci gli errori

con If not intresect..........

il classico è che cancellino più celle alla volta

con conseguente debug

Ciao Gianfranco

Grazie per l'intervento e per il like (immeritato, come vedi).

In verità, durante le prove, avevo inserito in qualche punto un ... or Target.Count > 1 per evitare la selezione di più di una cella che poi ho tolto perchè il Doppio_Click fa riferimento, credo, ad una sola cella per volta.

Quando parli di errori a cosa ti riferisci in particolare?

Ciao,

Mario

ciao

io normalmente quando uso il IF INTERSECT........

il primo te l'ho esposto.......selezione multipla..succede più spesso di quel che si pensi

disabilito gli eventi

Application.EnableEvents = False

Application.EnableEvents = True

se va in debug non li riabilita e bisogna usare la finestra immediata

perciò uso

On Error GoTo ERROR

ERROR:

Application.EnableEvents = True

vedo però che tu non lo usi

perciò immagino basti

On Error Resume Next

Postato da: @gianfranco55

↑

ciao

certo che puoi 

Ok grazie allora.

Qui il file con il mio tentativo di adattare la macro ad un altro progetto.

Non ho capito dove sto sbagliando:

@Mario

Il tuo file funziona perfettamente, non ho capito quale sarebbe la possible causa di errore di cui stai discutendo con Gianfranco. Dove modificare qualcosa nel tuo ultimo file che hai allegato?

A proposito, non mi hai risposto alla mia domanda sopra.

Basta il codice sopra per "materializzare" Il combo o devo inserire anche qualcosa dal menu sviluppo?

Grazie

ciao

in rosso le parti che non corrispondono al tuo file

e da variare

Private Sub UserForm_Initialize()
Dim lRiga As Long
Set wk = ThisWorkbook.Worksheets("Scadenzario 2023 Mesi")
lRiga = ActiveCell.Row
Call FormAlign(Me, wk.Cells(lRiga, 3))
End Sub
Sub FormAlign(MyForm, MyCell As Range)
Dim x#, y#
x = GetDeviceCaps(GetDC(0), 88) / 72
y = GetDeviceCaps(GetDC(0), 90) / 72
With MyForm
.StartUpPosition = 0
.Left = ActiveWindow.PointsToScreenPixelsX(MyCell.Left * x) * 1 / x
.Top = ActiveWindow.PointsToScreenPixelsY(MyCell.Top * y) * 1 / y + 70
'.Show
End With
Set MyForm = Nothing
End Sub

Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Application.Goto Reference:="Tabella2"
ActiveWorkbook.Worksheets("menu dinamici").ListObjects("Tabella2").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("menu dinamici").ListObjects("Tabella2").Sort.SortFields. _
Add Key:=Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("menu dinamici").ListObjects("Tabella2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C1").Select
Sheets("Scadenzario 2023 Mesi").Select
Application.ScreenUpdating = True
UserForm1.ComboBox1.RowSource = "Tabella2"
End Sub

ma ti consiglierei di usare quella di Marius

che è meno ostica da capire e gestire

Buongiorno a tutti

@gianfranco55 - Si, in effetti un errore (difficile ma sempre possibile) potrebbe creare qualche problema.

Penso che la cosa migliore sia impostare la gestione degli errori nella Function così:

Function PerCombo(ByRef Target, ByVal dati As String, ByVal cel As String)
Dim rgn() As String
On Error GoTo fine                        'xxxxxx riga aggiunta
  Application.ScreenUpdating = False
  ComboBox1.Left = Target.Offset(0, 1).Left + 6
  ComboBox1.Top = Target.Top
  ComboBox1.LinkedCell = Target.Address
  rgn = Split(dati, "!")
  With Sheets(2)
    .Select
    .Range(rgn(1)).Select
    Selection.Sort Key1:=.Range(cel), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End With
  Sheets(1).Select
  ComboBox1.ListFillRange = dati
  ComboBox1.Visible = True
fine:                            'xxxx riga aggiunta
Application.ScreenUpdating = True      'riga aggiunta
End Function

Cosa ne pensi? Ti sembra congruo?

Ciao,

Mario

@gianfranco.

Adesso funziona, grazie.

Si userò quella di marius, ma volevo capire l'errore

..."Perché alla fine si tratta di capire" 😉