Probleme copier/coller suite utilisation macro calendrier

Résolu
PAGEOT37 Messages postés 30 Statut Membre -  
PAGEOT37 Messages postés 30 Statut Membre -
Bonjour,

J'utilise dans un tableau plusieurs macro. Une d'elles consiste à faire apparaitre et disparaitre un calendrier dans une cellule. La macro en elle même fonctionne très bien mais lorsque que je veux faire un copier/coller d'une donnée quelconque et bien le copier fonctionne mais impossible de coller la donnée.

Voici la totalité des macro utilisées:

MACRO CALENDRIER 

Private Sub Calendar1_click()
    ActiveCell.Value = Calendar1.Value
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' si la sélection sur la feuille change (target est la référence de la sélection)
    If Target.Column <> 12 And Target.Column <> 13 And Target.Column <> Target.Row < 5 Or Target.Cells.Count > 1 Then
        'si la colonne <>3 (C) ou la ligne <2 ou la sélection fait plus d'1 cellule
        Calendar1.Visible = False
        'alors on cache le calendrier
        Exit Sub
    Else
        'sinon
        Calendar1.Top = Target.Offset(1, 0).Top + 2
        ' aligner le calendrier avec le haut de la cellule en dessous
        Calendar1.Left = Target.Left + 0
        ' l'aligner à gauche de la cellule
        'Calendar1.LinkedCell = Target.Address
        ' mettre la cellule liée au contrôle sur la cellule sélectionnée
        If IsDate(Target.Value) Then
        'si la cellule sélectionnée contient une date
            Calendar1.Value = Target.Value
            ' la récupérer
        Else
            ' sinon mettre la date du jour
            Calendar1.Value = Date
        End If
        Calendar1.Visible = True
        'afficher le calendrier
    End If
End Sub


MACRO CHANGEMENT DES COULEURS CELLULES 

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range("B:z")) Is Nothing Then
Select Case Target.Value
Case Is = "Oui": Target.EntireRow.Range("b1:Z1").Interior.ColorIndex = 35: Target.EntireRow.Range("S1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
Case Is = "Non": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 15:
Case Is = "Favorable": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 35: Target.EntireRow.Range("s1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
Case Is = "Défavorable": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 15
Case Is = "Apte": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 35: Target.EntireRow.Range("s1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
Case Is = "Inapte": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 15
'Elimination des couleurs dans cellules vides
Case Is = "": Target.EntireRow.Range("b1:Q1").Interior.ColorIndex = 35: Target.EntireRow.Range("s1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
End Select
End If
End Sub


MACRO INSERTION COMMENTAIRE PAR BOUBLE CLICK CELLULE 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Application.Intersect(Target, Range("b:k,n:z")) Is Nothing Then
   With Target
     If .NoteText = "" Then
        reponse = InputBox("INDIQUEZ LE COMMENTAIRE")
        If reponse <> "" Then
            .AddComment reponse
            With .Comment.Shape.OLEFormat.Object.Font
              .Name = "ARIAL"
              .Size = 10
              .FontStyle = "gras"
              .ColorIndex = 1
            End With
            .Comment.Shape.Fill.ForeColor.RGB = RGB(255, 255, 0)
            .Comment.Visible = True
            .Comment.Shape.Select
            Selection.AutoSize = True
            .Comment.Visible = False
            Selection.HorizontalAlignment = xlCenter
            Selection.VerticalAlignment = xlCenter
            .Comment.Shape.Top = Target.Top + 3
            .Comment.Shape.Left = Target.Left + 35
            .Comment.Shape.Placement = xlMove
         End If
      Else
        .Comment.Delete
      End If
   End With
 End If
 Cancel = True
End Sub


Merci d'avance

10 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    Il faut trouver une parade avec une Booléenne dans le clic droit comme ceci: 

    Option Explicit
Dim copier As Boolean
Private Sub Calendar1_Click()
ActiveCell.Value = Calendar1.Value
copier = False
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
copier = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If copier = True Then Exit Sub
' si la sélection sur la feuille change (target est la référence de la sélection)
 If Target.Column <> 12 And Target.Column <> 13 And Target.Column <> Target.Row < 5 Or Target.Cells.Count > 1 Then
 'si la colonne <>3 (C) ou la ligne <2 ou la sélection fait plus d'1 cellule
 Calendar1.Visible = False
 'alors on cache le calendrier
 Exit Sub
 Else
 'sinon
 Calendar1.Top = Target.Offset(1, 0).Top + 2
 ' aligner le calendrier avec le haut de la cellule en dessous
 Calendar1.Left = Target.Left + 0
 ' l'aligner à gauche de la cellule
 'Calendar1.LinkedCell = Target.Address
 ' mettre la cellule liée au contrôle sur la cellule sélectionnée
 If IsDate(Target.Value) Then
 'si la cellule sélectionnée contient une date
 Calendar1.Value = Target.Value
 ' la récupérer
 Else
 ' sinon mettre la date du jour
 Calendar1.Value = Date
 End If
 Calendar1.Visible = True
 'afficher le calendrier
 End If
End Sub


    et l'on rétabli par un clic dans le Calendar

    Essayer!
    0
  2. PAGEOT37 Messages postés 30 Statut Membre 1
     
    Bonjour, et merci d'avoir répondu.

    Effectivement, avec une Booléenne pas de problème ca marche....En revanche elle rentre en conflit avec la macro "MACRO INSERTION COMMENTAIRE PAR BOUBLE CLICK CELLULE"et le calendrier ne s'affiche plus.
    0
  3. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Mettre ceci: 

    'MACRO INSERTION COMMENTAIRE PAR BOUBLE CLICK CELLULE
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
copier = False


    en cliquant dans les colonnes 12 et 13, il s'affiche de nouveau!
    0
  4. PAGEOT37 Messages postés 30 Statut Membre 1
     
    Le problème est toujours pareil. Le copier/coller marche. Une fois avoir collé ma donnée si je veux retourner sur le calendrier, il ne marche plus. Et de plus si je veux insérez un commentaire par le double click dans la cellule il me dit:
    ERREUR DE COMPILATION et me sourligne en jaune la commande ci-dessous
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) qui correspond à ma macro "insertion commentaire par double click"

    J'aimerais bien mettre le fichier en pièce jointe, mais je ne trouve l'icone.
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Chez moi avec le code donné cela fonctionne, je n'ai pas de message d'erreur. Tu as peut-être autre chose qui empêche le double clic.

    Pour mettre un fichier, il n'y a pas d'icone il faut le déposer sur le site cjoint. Ensuite tu copies le lien et tu le mets sur le post

    https://www.cjoint.com/
    0
  8. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    J'ai fait quelques corrections. Chez moi cela fonctionne avec Excel 2003:

    http://www.cjoint.com/data3/3BcnTjfslcX.htm
    0
  9. PAGEOT37 Messages postés 30 Statut Membre 1
     
    Ca marche de façon aléatoire, mais une fois avoir fais collé, le calendar n'apparait plus.
    0
  10. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    I l faut double cliquer en insistant dans les colonnes 12 et 13, il s'affiche de nouveau!
    0
  11. PAGEOT37 Messages postés 30 Statut Membre 1
     
    Effectivement ca marche, merci....
    0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses
Arobase
Zezette -
MPMP10 -

1 réponse
comment faire une arobase
GLORIA -
baladur13 -

1 réponse