Userform multi usage

Bonjour

J'aimerai savoir si on peut utiliser un même userform pour plusieurs actions, je m'explique : quand je clique sur une cellule je souhaite appeler mon userform et insérer mon choix dans la cellule active & en cliquant sur une autre cellule insérer plusieurs choix au dessous de la cellule active [pour éviter de créer 2 fois le même userform qui propose la même liste de choix]. Le code écrit ne marche pas :

Private Sub CommandButton1_Click()
Dim a As Integer, b As Integer

    a = ActiveCell.Row
    b = ActiveCell.Column

   If ActiveCell = A1 Then

   MultiSelect = 1 - fmMultiSelectMulti

    For i = 0 To UserForm.ListBox.ListCount - 1
        If UserForm.ListBox.Selected(i) = True Then
           Cells(a + 1, b) = UserForm.ListBox.List(i)
           a = a + 1
        End If
    Next i

    With Range(ActiveCell.Offset(1, 0), Cells(a, b)).Borders
   .LineStyle = xlContinuous
   .Weight = xlThin
   .ColorIndex = xlAutomatic
  End With

   ElseIf ActiveCell = C2 Then

   MultiSelect = 1 - fmMultiSelectSingle

   For i = 0 To UserForm.ListBox.ListCount - 1
        If UserForm.ListBox.Selected(i) = True Then
           ActiveCell = UserForm.ListBox.List(i)
        End If
    Next
   End If

   ActiveCell.BorderAround Weight:=xlThin

  Unload Me
End Sub

Quelqu'un aurait-il une idée de ce qui ne vas pas?

Merci

Bonjour

A tester

Le code marche bien sauf pour la suppression du contenu de la cellule active, une idée pourquoi?

Merci.

Comment peut-on mieux écrire le code suivant:

'If ActiveCell.Address = "$C$15" Or ActiveCell.Address = "$G$15" Or ActiveCell.Address = "$K$15" Then

?

Puis-je également savoir à quoi sert le code suivant dans notre exemple?

If Me.ListBox.ListIndex = -1 Then Exit Sub

Bonjour

Pour remplacer

If ActiveCell.Address = "$C$15" Or ActiveCell.Address = "$G$15" Or ActiveCell.Address = "$K$15" Then

utilises

If Not Intersect(Range("C15,G15,K15"), Target) Is Nothing then

Pour

 If Me.ListBox.ListIndex = -1 Then Exit Sub

Indique : Si pas de sélection dans la ListBox on dégage

Merci mais j'ai essayé

If Not Intersect(Range("C15,G15,K15"), Target) Is Nothing then

mais ça n'a pas marché en dehors de

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

je ne sais pas pourquoi [ peut etre car Target non déclaré as Range?]

Bonjour

VBE_Learner a écrit :

mais ça n'a pas marché en dehors de

Expliques un peu mieux ou fournis le fichier : Cela sera plus pratique

Sinon on va passer par le jeu des questions/réponses

Voici mon code :

Private Sub UserForm_Initialize()
Dim target As Range
Me.ListMe.List = Sheets("X").Range("d1", Sheets("X").Range("d1").End(xlDown)).Value
If Not Intersect(Range("C15,G15,K15"), target) Is Nothing Then
'If ActiveCell.Address = "$C$15" Or ActiveCell.Address = "$G$15" Or ActiveCell.Address = "$K$15" Then
     Me.ListMe.MultiSelect = fmMultiSelectMulti
    Else
      Me.ListMe.MultiSelect = fmMultiSelectSingle
    End If

Me.StartUpPosition = Manual
  With ActiveCell
    Me.Left = .Left + (1.5 * .Width)
    Me.Top = .Top + (1 * .Height) - ActiveWindow.VisibleRange(1, 1).Top
  End With
End Sub

Apres j'ai un msg d'erreur.

L'erreur me renvoie vers l'action double-clic en mettant en jaune Load userforme

If Not Intersect(Range("C15,G15,K15"), target) Is Nothing Then
    With Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0).End(xlDown))
    .ClearContents
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    End With

         [color=#FFFF00]Load Me[/color]
         Me.Show
         Cancel = True

    End If

J'espère que c'est claire.

Bonjour

remplaces ta 1ère macro

    Private Sub UserForm_Initialize()

    Me.ListMe.List = Sheets("X").Range("d1", Sheets("X").Range("d1").End(xlDown)).Value
    If Not Intersect(Range("C15,G15,K15"), ActiveCell) Is Nothing Then
    'If ActiveCell.Address = "$C$15" Or ActiveCell.Address = "$G$15" Or ActiveCell.Address = "$K$15" Then
        Me.ListMe.MultiSelect = fmMultiSelectMulti
        Else
          Me.ListMe.MultiSelect = fmMultiSelectSingle
        End If

    Me.StartUpPosition = Manual
      With ActiveCell
        Me.Left = .Left + (1.5 * .Width)
        Me.Top = .Top + (1 * .Height) - ActiveWindow.VisibleRange(1, 1).Top
      End With
    End Sub

Remplaces ta 2ème macro

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  If Not Intersect(Range("C15,G15,K15"), Target) Is Nothing Then
    Cancel = True
    Range(Target.Offset(1, 0), Target.Offset(1, 0).End(xlDown)).Clear
    UserForm.Show
  End If
End Sub

ça marche merci.