Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
valeur d'une liste de choix choisi par case a cocher
J'ai un casse tête a exposé ( casse tête pour moi )
dans dans la feuil1 j'ai une liste mis a jour régulièrement dans la feuil2 une liste de choix pris de la colonne A
mon casse tête est que dans la liste je souhaiterais qu'il n'apparaissent que les codes choisi par une case cocher par exemple en C ou une valeur saisie en C
il me faut conserver tout les codes car tout les mois je n'ai pas besoin forcement de tout mais a l'année si
Re : valeur d'une liste de choix choisi par case a cocher
Bonjour,
Une piste mais en VBA dont voici la marche à suivre
1) Créez un classeur avec 2 feuilles nommées, respectivement, "Feuil1" et "Feuil2"
2) dans "Feuil1" inscrivez vos données en colonnes A et B. Si une donnée quelconque figure en colonne C alors les données
en colonnes A et B seront répercutées dans la ComboBox
3) Dans un module Standard, copiez le code suivant
Code:
'### Constantes à adapter éventuellement ###
Const BDD As String = "Feuil1" 'nom de la feuille de la base de données
Const LISTE As String = "Feuil2" 'nom de la feuille contenant la ComboBox
Const LISTE_DESTINATION As String = "A6" 'cellule contenant la ComboBox
Const COMBO_NOM As String = "pmo" 'nom arbitraire de la ComboBox
'###########################################
Sub CreeComboBox(Optional dummy As Byte)
Dim S As Worksheet
Dim CB As ComboBox
Dim OLE As OLEObject
Dim R As Range
Dim var
Dim T()
Dim i&
Dim j&
Dim cpt&
Set S = Sheets(BDD)
Set R = S.Range("a2:c" & S.[a2].End(xlDown).Row & "")
var = R
For i& = LBound(var, 1) To UBound(var, 1)
If Trim(var(i&, 3)) <> "" Then cpt& = cpt& + 1
Next i&
If cpt& = 0 Then
MsgBox "Aucun choix n'a été effectué."
Exit Sub
End If
ReDim T(1 To cpt&, 1 To 3)
cpt& = 0
For i& = LBound(var, 1) To UBound(var, 1)
If Trim(var(i&, 3)) <> "" Then
cpt& = cpt& + 1
For j& = 1 To 3
T(cpt&, j&) = var(i&, j&)
Next j&
End If
Next i&
Set S = Sheets(LISTE)
Set R = S.Range(LISTE_DESTINATION)
On Error Resume Next
S.OLEObjects(COMBO_NOM).Delete
On Error GoTo 0
Set OLE = S.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)
OLE.Placement = xlMoveAndSize
OLE.Name = COMBO_NOM
Set CB = OLE.Object
CB.ColumnCount = 3
CB.ColumnWidths = "20;0;0"
CB.List = T
CB.ShowDropButtonWhen = fmShowDropButtonWhenFocus
CB.BackColor = vbYellow
End Sub
4) dans la fenêtre de code de ThisWorkbook, copiez le code suivant
Code:
Private Sub Workbook_Open()
Call CreeComboBox
End Sub
5) dans la fenêtre de code de "Feuil2", copiez le code suivant
(si l'instruction Option Explicit y figure, la SUPPRIMER pour ce cas particulier)
Code:
Private OLDpattern As Long
Private OLDcolor As Long
Private R As Range
Private Sub pmo_Change()
R = pmo.Value
With R.Interior
.Pattern = OLDpattern
.ColorIndex = OLDcolor
End With
End Sub
Private Sub pmo_GotFocus()
Set R = Selection
With R.Interior
OLDpattern = .Pattern
OLDcolor = .ColorIndex
.Pattern = xlGray8
.ColorIndex = 6
End With
End Sub
Private Sub pmo_LostFocus()
With R.Interior
.Pattern = OLDpattern
.ColorIndex = OLDcolor
End With
Set R = Nothing
Call CreeComboBox
End Sub
6) dans la fenêtre de code de "Feuil1", copiez le code suivant
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Call CreeComboBox
End Sub
FONCTIONNEMENT
Tout se fait par code. A l'ouverture du classeur, une ComboBox se construira automatiquement dans "Feuil2" avec les données des colonnes A,B,C de "Feuil1" dans la mesure où existe une donnée quelconque en colonne C.
Dans "Feuil2", sélectionnez la cellule dans laquelle vous voulez inscrire ce que vous choisirez dans la ComboBox.
(Ex : sélectionnez B15, cliquez sur le bouton de la ComboBox. La cellule réceptrice B15 se colore en jaune pointillé et recevra la sélection de la ComboBox)
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.