Comment lire une date dans un calendrier ?

dmoluc

XLDnaute Occasionnel
Bonsoir à tous,

Depuis la cellule G5 jusqu'à la cellule DM5 j'ai des cellules fusionnées par paires (G5:G6) = lundi 6 Août 2012, (G7:G8) mardi 7..... etc

voilà la macro que j'ai bricoler avec mes maigres connaissances

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect

Dim Ligne
Dim Colonne
Dim A As Variant


If Not Intersect(Target, Range("D5:D36")) Is Nothing Then


 
   'Je lance l'userform

      UserForm1.Show
 'Si la première colonne de mon tableau de g6 à g36 est vide j'impute la date du DTPicker21 qui est sur la feuille "Programme des travaux" au DTPicker1 sur L'UserForm1
    
      If Application.WorksheetFunction.Sum(Range("G6:G36")) = 0 Then
      UserForm1.DTPicker1.Value = Me.DTPicker21.Value
       UserForm1.Durée.Value = Range("D36").End(xlUp).Offset(0, 1).Value
       ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      Exit Sub
      End If
      
       Ligne = 5
       
      If Application.WorksheetFunction.Sum(Range("G6:G36")) <> 0 Then

'Durée = combobox sur l'userform1 et jusque là ça fonctionne très bien
      UserForm1.Durée.Value = Range("D36").End(xlUp).Offset(0, 1).Value

Je fais de la gymnastique avec les offset de façon à me positionner sur ma dernière entrée dans le tableau, puis remonter sur la ligne afin d'y lire la date
 
     Range("D36").End(xlUp).Offset(-1, 106).Select

'Je trouve bien le N° de colonne
      Colonne = ActiveCell.End(xlToLeft).Column

'mais à partir d'ici plus rien ne fonctionne, pas moyen de sélectionner la cellule correspondante
       ActiveCell(Ligne, Colonne).Offset(1, 0).Select

'Pas moyen de récupérer la date
      A = ActiveCell(Ligne, Colonne).Value

   'donc cette condition ne s'exécute jamais   
       If A <> 0 Then
      UserForm1.DTPicker1.Value = ActiveCell(Ligne, Colonne).Value
      ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      Exit Sub
      End If
  'Et celle-ci toujour puisque je n'ai pas de date dans A, mais bien sur il y a erreur puisque ça lie soit la deuxième cellule de la fusion ou il y a rien soit comme en haut je n'arrive pas à lire la date     
      If A = 0 Then
      UserForm1.DTPicker1.Value = ActiveCell(Ligne, Colonne +1).Value
       End If

   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   End If
   Exit Sub
ETIQUETTE: MsgBox "Changer la date manuellement & vbokonly"
  
      
End Sub

Je sais que mon code n'est pas chouette mais il devrait être fonctionnel si j'arrivais à lire la date

Merci pour votre aide car là je bute vraiment

Cordialement

Didier
 

dmoluc

XLDnaute Occasionnel
Re : Comment lire une date dans un calendrier ?

Bonjour,
Les cellules fusionnées me servent aussi, et pour la mise en page, et elles sont bien pratique lorsque je colores les jours fériés. Je sais aussi qu'en VBA , normalement excel ne tient pas compte de la fusion donc suivant la colonne ou je me trouve, un coup je devrais lire la date, un autre je devrais trouver une cellule vide, alors pourquoi
A = ActiveCell(Ligne, Colonne).Value est toujours vide ?
Merci pour votre aide
 

dmoluc

XLDnaute Occasionnel
Re : Comment lire une date dans un calendrier ?

Je viens de défusionner les cellules de la ligne 5 et A = ActiveCell(Ligne, Colonne).Value est toujours vide quoi qu'il arrive, donc le problème est ailleurs, mais où ? Si quelqu'un avait une idée, se serait super
merci
 

dmoluc

XLDnaute Occasionnel
Re : Comment lire une date dans un calendrier ?

Bonsoir à tous

Merci Frangy, avec ton code il ya du mieux car maintenant la cellule de la ligne 5 qui contient la date est selectionnée, mais toujours impossible d'imputer la date à A :mad:
Aujourd'hui j'étais en balade et je n'ai pas eu trop le temps de m'occuper de la chose mais demain matin je vais creuser un peu plus la piste que tu m'as fournis...

Merci encore
 

dmoluc

XLDnaute Occasionnel
Re : Comment lire une date dans un calendrier ?

Finalement je n'ai pas eu grand chose à modifier

le code à Frangy à peine retoucher
Cells(Ligne, Colonne).Select
A = ActiveCell.Value

et les 2 conditions
If A <> "" Then
UserForm1.DTPicker1.Value = A
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
End If

If A = "" Then
UserForm1.DTPicker1.Value = Selection.Offset(0, 1).Value
End If

Merci encore une fois, parfois on bute sur des trucs bête sans trouver la moindre solution et ça fait vraiment plaisir de pouvoir trouver un peu d'aide
Bonsoir à tous et A+
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon