Microsoft 365 msgbox avec liste de choix

[Usine à gaz]

Bonjour à toutes et à tous,


Je me tourne une nouvelle fois vers nos ténors

J'ai fait des p'tits tests UF pour faire des choix de nombres ... Pas de souci particulier pour ça
Mais les UF, me semble-t-il, alourdissent les classeurs et les miens sont déjà plutôt lourds et "Usines à gaz" comme disent les Amis lol.

Je me demandais si ce ne serait pas mieux (si c'est possible ?) de faire ce choix à l'aide, par exemple, d'un msgbox avec liste de choix ?
J'ai fait des recherches et pas mal d'essais sans succès.

Si c'est possible, auriez-vous le bon code ?
En cas, je joins une fichier test.
Merci pas avance,
Amicalement,
lionel,

 

[Usine à gaz]

Super merci pour tout ce super travail.
merci pour tout le temps que tu y as passé.
lionel

 

[laurent950]

Re Lionel,

Pour la Msgbox

Ce que j'ai ajouté :
' Msgbox (Pour la boite de message)
Dim StrString As String
Dim tmp() As Variant
tmp = tbl: ReDim Preserve tmp(UBound(tmp) - 1)
StrString = "Liste de choix" & vbCrLf & Join(tmp, vbCrLf & "")
tbl(UBound(tbl)) = MsgBox(StrString, tbl(UBound(tbl)), "CLIC SUR LA BONNE REPONSE")
' Les valeurs
'ReDim Preserve tbl(UBound(tbl) - 1)
tbl = tmp: Erase tmp

Sub MsgBoxListeDeChoix2()
Dim WS As Worksheet
    Set WS = ActiveSheet
Dim tbl() As Variant
    tbl = Array(0, 1, 2, 5, 10, 15, 20, 30, 0)
' Msgbox
Dim StrString As String
Dim tmp() As Variant
    tmp = tbl: ReDim Preserve tmp(UBound(tmp) - 1)
    StrString = "Liste de choix" & vbCrLf & Join(tmp, vbCrLf & "")
    tbl(UBound(tbl)) = MsgBox(StrString, tbl(UBound(tbl)), "CLIC SUR LA BONNE REPONSE")
' Les valeurs
    'ReDim Preserve tbl(UBound(tbl) - 1)
    tbl = tmp: Erase tmp
' La Liste Box
Dim oCombo As OLEObject
Dim L As Single, T As Single, W As Single, H As Single
    L = ActiveCell.Left     'L = 180 '<-- position horizontale
    T = ActiveCell.Top      'T = 80 '<-- position verticale
    W = ActiveCell.Width    'W = 130 '<-- largeur
    H = ActiveCell.Height   'H = 22 '<-- hauteur
' Si la liste existe
    For Each oCombo In WS.OLEObjects
        If oCombo.progID = "Forms.ComboBox.1" Then
            If oCombo.Name = "Combo1" Then
                oCombo.Delete
            End If
        End If
    Next
' Creation de la liste de choix
    Set oCombo = WS.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=L, Top:=T, Width:=W, Height:=H)
With oCombo
    .Name = "Combo1" '<-- nom du Combobox
    .Object.List() = tbl    '<-- exemple de chargement des données
    .Object.TextAlign = 3   ' Aligne le texte a droite
    .Object.DropDown        ' Déroule le menu
End With
Set oCombo = Nothing
End Sub

 

[Usine à gaz]

Merci encore pour ce travail
j'avais désactivé la Msgbox me permettant ainsi d'être directement sur la liste déroulante et c'est super

Encore un petit truc (le dernier je pense) :

Je joins le fichier et je continue à chercher comment l'enlever.
lionel

 

[laurent950]

Je joins le fichier et je continue à chercher comment l'enlever.

C'est qu'elle module dans votre classeur ? pour le code

 

[Usine à gaz]

C'est dans le module 1:

Sub MsgBoxListeDeChoix2()
Dim WS As Worksheet
    Set WS = ActiveSheet
Dim tbl() As Variant
    tbl = Array(0, 2, 5, 10, 15, 20, 30, 0)
' Msgbox
    'tbl(UBound(tbl)) = MsgBox("Liste de choix", tbl(UBound(tbl)), "CLIC SUR LA BONNE REPONSE")
' Les valeurs
    ReDim Preserve tbl(UBound(tbl) - 1)
' La Liste Box
Dim oCombo As OLEObject
Dim L As Single, T As Single, W As Single, H As Single
    'L = 180 '<-- position horizontale
    L = ActiveCell.Left
    'T = 80 '<-- position verticale
    T = ActiveCell.Top
    'W = 130 '<-- largeur
    W = ActiveCell.Width
    'H = 22 '<-- hauteur
    H = ActiveCell.Height
' Si la liste existe
    For Each oCombo In WS.OLEObjects
        If oCombo.progID = "Forms.ComboBox.1" Then
            If oCombo.Name = "Combo1" Then
                oCombo.Delete
            End If
        End If
    Next
' Creation de la liste de choix
    Set oCombo = WS.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=L, Top:=T, Width:=W, Height:=H)
With oCombo
    .Name = "Combo1" '<-- nom du Combobox
    .Object.List() = tbl '<-- exemple de chargement des données
    .Object.TextAlign = 3 ' Aligne le texte a droite
    .Object.DropDown ' Déroule le menu
End With
Set oCombo = Nothing
CreateObject("wscript.shell").SendKeys "%{down}"
End Sub

 

[laurent950]

Re

Votre modification et faite ou dans votre code ci-dessus ?

j'avais désactivé la Msgbox me permettant ainsi d'être directement sur la liste déroulante et c'est super

 

[Usine à gaz]

Oui, dans le fichier joint "Module1",

 

[laurent950]

Re

Cette ligne sert a quoi ? CreateObject("wscript.shell").SendKeys "%{down}"

ici maintenant
Dim tbl() As Variant
'tbl = Array(0, 2, 5, 10, 15, 20, 30, 0)
tbl = Array(0, 2, 5, 10, 15, 20, 30)
' Msgbox
'tbl(UBound(tbl)) = MsgBox("Liste de choix", tbl(UBound(tbl)), "CLIC SUR LA BONNE REPONSE")
' Les valeurs
ReDim Preserve tbl(UBound(tbl) - 1)

 

[Usine à gaz]

"Cette ligne sert a quoi ? CreateObject("wscript.shell").SendKeys "%{down}""
= Ouvrir automatiquement la liste de validation

 

[laurent950]

"Cette ligne sert a quoi ? CreateObject("wscript.shell").SendKeys "%{down}""
= Ouvrir automatiquement la liste de validation

elle s'ouvre déjà avec cette ligne avant : .Object.DropDown ' Déroule le menu

Pour votre question en poste #18 c'est l'affichage par default, non modifiable.

Sub MsgBoxListeDeChoix2()
Dim WS As Worksheet
    Set WS = ActiveSheet
Dim tbl() As Variant
    'tbl = Array(0, 2, 5, 10, 15, 20, 30, 0)
    tbl = Array(0, 2, 5, 10, 15, 20, 30)
' Msgbox
    'tbl(UBound(tbl)) = MsgBox("Liste de choix", tbl(UBound(tbl)), "CLIC SUR LA BONNE REPONSE")
' Les valeurs
    'ReDim Preserve tbl(UBound(tbl) - 1)
' La Liste Box
Dim oCombo As OLEObject
Dim L As Single, T As Single, W As Single, H As Single
     L = ActiveCell.Left      ' L = 180 '<-- position horizontale
    T = ActiveCell.Top       ' T = 80 '<-- position verticale
    W = ActiveCell.Width  ' W = 130 '<-- largeur
    H = ActiveCell.Height  ' H = 22 '<-- hauteur
' Si la liste existe
    For Each oCombo In WS.OLEObjects
        If oCombo.progID = "Forms.ComboBox.1" Then
            If oCombo.Name = "Combo1" Then
                oCombo.Delete
            End If
        End If
    Next
' Creation de la liste de choix
    Set oCombo = WS.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=L, Top:=T, Width:=W, Height:=H)
With oCombo
    .Name = "Combo1" '<-- nom du Combobox
    .Object.List() = tbl '<-- exemple de chargement des données
    .Object.TextAlign = 3 ' Aligne le texte a droite
    .Object.DropDown ' Déroule le menu
End With
Set oCombo = Nothing:   Set WS = Nothing: Erase tbl
L = Empty: T = Empty: W = Empty: H = Empty
End Sub

 

[Usine à gaz]

Désolé, je ne l'avais pas vu et c'était le fait que j'ai ajouté la ligne qui à provoqué "le truc" intempestif"
Vraiment désolé de t'avoir fait passer plus de temps

C'est parfait, Génial !
Merci pour ce super travail
Voilà un code très utile.
Encore merci à toi
lionel

 

[Usine à gaz]

Bonjour laurent950, le Forum,
Je vous souhaite à toutes et à tous une belle journée

Merci Laurent pour ta patience et ta ténacité
Je joins le fichier "finalisé" qui fonctionne "du tonnerre" et qui pourra être utile pour d'autres

Je profite de ce fil pour un souci d'intégration dans mon fichier de travail,
code dans la feuille :

Aurais-tu une idée ?
je continue mes tests,
Amicalement,
lionel

 

[Usine à gaz]

Bonjour Laurent, le Forum,

Après beaucoup de tests, je confirme. Ton code fonctionne super bien
Un grand merci

Je cherche à ajouter une info.
Pas très indispensable mais, même si ça va sans dire, ça va tjrs mieux en le disant lol

Je voudrais ajouter une petit texte dans la combo1 :

"aujourd'hui + nbr jrs"
Est-ce possible ?
Je cherche de mon côté,
lionel

 

[Usine à gaz]

Bonjour à toutes et à tous, Bonjour laurent950,
Je vous souhaite une belle journée

J'ai encore modifié le fichier test en y incluant un UF pour annuler si erreur de clic.
Comme mon Cher Job75, je suis jusqu'au-boutiste lol
Il ne me reste plus qu'a ajouter une petit texte dans la combo1 :

"aujourd'hui + nbr jrs"

Je joins le fichier à ce stade d'évolution.
Je continue mes recherches,
Amicalement,
lionel,

 

[Eric C]

Bonjour le forum
Bonjour le fil

@Lionel :
J'ai fait des p'tits tests UF pour faire des choix de nombres ... Mais les UF, me semble-t-il, alourdissent les classeurs et les miens sont déjà plutôt lourds et "Usines à gaz" comme disent les Amis lol.

Eh ben Lionel, après avoir parcouru ce fil, on peut observer que cette fois ci, tu vas faire light en utilisant seulement :
- du code (bien sûr)
- du contrôle ActiveX
- un UserForm (Euh.. tu ne disais pas que ....je ne sais plus ???)
- une Macro Excel4
- l'exécution d'une commande externe avec écriture dans la base de registre ....

Je ne veux pas être ton programme lorsque tu vas lui sortir l'artillerie lourde
Bon Ok, je sors
Bonne après-midi à toutes & à tous
@+ Eric c