utiliser deux fois BeforeDoubleClick

[tinet]

Bonjour le forum,

Question j'ai récuperer ce code sur le forum pour une fonction dans mon fichier.
Ma question pouvons nous sur la même feuille utiliser deux fois BeforeDoubleClick
en limitant les colonnes.

Premier sur colonne G et I uniquement sur ce code

Private Sub Worksheet_(ByVal Target As Range, Cancel As Boolean)
  Dim sDate As Date
  'If IsDate(Target) Then Cancel = True Else Exit Sub
  Cancel = True
  ' Récupérer la date de la cellule et l'inscrire dans le champ masqué
  vDate = IIf(IsDate(Target.Value), Target.Value, Date)
  ' Afficher l'USF
  UsFCalendrier.Show
End Sub

et deuxième sur ce code sur la colonne B,C,D,E

'loupe sur la page
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 On Error Resume Next
 If Target.Count = 1 And ActiveSheet.Shapes("monshape").Visible = True Then
   If Err <> 0 Then creeShape
   ActiveSheet.Shapes("monshape").Left = ActiveCell.Left
   ActiveSheet.Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
   ActiveSheet.Shapes("monshape").TextFrame.Characters.Text = ActiveCell
 End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   ActiveSheet.Shapes("monshape").Visible = Not ActiveSheet.Shapes("monshape").Visible
   If ActiveSheet.Shapes("monshape").Visible Then
     ActiveSheet.Shapes("monshape").Left = ActiveCell.Left
     ActiveSheet.Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
     ActiveSheet.Shapes("monshape").TextFrame.Characters.Text = ActiveCell
   End If
   Cancel = True
End Sub
Sub creeShape()
  ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 180, 50).Select
  Selection.Font.Name = "Verdana"
  Selection.Font.Size = 13
  Selection.Name = "monshape"
  ActiveSheet.Shapes("monshape").Left = ActiveCell.Left
  ActiveSheet.Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

 

[Dull]

Re : utiliser deux fois BeforeDoubleClick

Salut tinet, le Forum

Fait une recherche sur la fonction Intersect()

du Style

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
       If Not Intersect(Target, Range("B1:E65500")) Is Nothing Then
          Cancel=True
               'TonCode
       End If
      If Not Intersect(Target, Range("G1:I65500")) Is Nothing Then
         Cancel=True
              '2èmeTonCode
      End If
  End Sub

A Adapter

Bonne Journée

 

[tinet]

Re : utiliser deux fois BeforeDoubleClick

Bonjour dull,

malheureusement, je peux faire des copier coller de code, mais pas possible pour moi de l'adapté.