Fonction copier/coller inactive à la suite d'une macro calendrier

PAGEOT37

XLDnaute Nouveau
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. En supprimer la macro du calendrier la fonction copier/coller fonctionne. Je ne comprends pas????????

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
 

Discussions similaires

Statistiques des forums

Discussions
312 164
Messages
2 085 877
Membres
103 009
dernier inscrit
dede972