probleme copier/coller suite utilisation macro calendrier Résolu

Question

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

cs_Le Pivert · Answer

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!

PAGEOT37 · Answer

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.

cs_Le Pivert · Answer

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!

PAGEOT37 · Answer

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.

cs_Le Pivert · Answer

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/

PAGEOT37 · Answer

Voici, le lien

https://www.cjoint.com/c/EBcl1C3q8QR

cs_Le Pivert · Answer

J'ai fait quelques corrections. Chez moi cela fonctionne avec Excel 2003:

 http://www.cjoint.com/data3/3BcnTjfslcX.htm

PAGEOT37 · Answer

Ca marche de façon aléatoire, mais une fois avoir fais collé, le calendar n'apparait plus.

cs_Le Pivert · Answer

I l faut double cliquer en insistant dans les colonnes 12 et 13, il s'affiche de nouveau!

PAGEOT37 · Answer

Effectivement ca marche, merci....

Probleme copier/coller suite utilisation macro calendrier

10 réponses

Discussions similaires

Newsletters