[Résolu par job75] Décaler d'une cellule si cellule est pleine

Lone-wolf

XLDnaute Barbatruc
Bonsoir à tous,

désolé mais j'ai vraiment du mal avec les Offset. Dans le fichier joint, je n'arrive pas à faire en sorte de faire décaler d'une cellule quand celle-ci est pleine.

Les explications dans le fichier, voir date du jour. La macro doit remplir que 7 cellules.



A+ :cool:
 

Pièces jointes

  • Classeur1-1.xlsm
    17.3 KB · Affichages: 55
  • Classeur1-1.xlsm
    17.3 KB · Affichages: 74
Dernière édition:

Regueiro

XLDnaute Impliqué
Re : Décaler d'une cellule si cellule est pleine

Bonsoir le Forum - LoneWolf
Test si target est au format Date
Code:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Application.Intersect(Target, Range("B2:H45")) Is Nothing Then

  MsgBox "Vous avez double cliqué sur la cellule " & Target.Address
    If IsDate(Target) And Target.Value <> "" Then
        MsgBox "Ok Format Date"
        Target.Offset(1, 0).Select
    End If
  End If
  Cancel = True
End Sub

@+
 

Lone-wolf

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Bonjour Regueiro,

je ne comprends pas pourquoi faire le test. Les zones en dessous des dates non pas de format direct et le double clic je le fait en dehors du tableau.


Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cel As Range
For Each cel In Range("b2:h45")
If cel.Value = Date Then cel.Offset(1, 0) = Format(Now, "hh:mm")
Next cel
End Sub


Explication: chaque jour 7 personnes éffectuent un enregistrement du classeur(après modification de celui-ci). Dans les cellules en dessous de la date du 31.03.2016 par exemple, doit s'afficher l'heure de lenregistrement de chaque personne.




A+ :cool:
 
Dernière édition:

cathodique

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Bonjour,

Tu double cliques, 7 cellules se remplissent
VB:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Byte
    If Not Application.Intersect(Target, Range("B2:H45")) Is Nothing Then

        Target.FormulaR1C1 = "=now()"
        If IsDate(Target) And Target.Value <> "" Then
            For i = 1 To 6
                Target.Offset(0, i).FormulaR1C1 = "=now()"
            Next i
        End If
    End If
    Cancel = True
End Sub
 

cathodique

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Pas encore bien réveillé, avais mal compris
VB:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Byte
    If Not Application.Intersect(Target, Range("B2:H45")) Is Nothing Then

        Target = Now
        If IsDate(Target) And Target.Value <> "" Then
            Target.Offset(1, 0) = Format(Now, "hh:mm")
        End If
    End If
    Cancel = True
End Sub
 

Lone-wolf

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Bonjour cathodique,

il y a un petit malentendu. Ce n'est pas Target.Offset(0, i) mais Target.Offset(i, 0). Mais ce n'est pas bon non plus. Et la macro devrait être plus logiquement dans workbook_beforeclose(); mais c'est de ma faute. J'ai mis sous double clic pour faire les tests.

un exemple: M. X éffectue un enregistrement à 07:55 la cellule note l'heure. Mme LD en fait de même à 08:15, la cellule en dessous note l'heure de Mme LD et ainsi de suite.



A+ :cool:
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Bonjour,

Tu double cliques, 7 cellules se remplissent
VB:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Byte
    If Not Application.Intersect(Target, Range("B2:H45")) Is Nothing Then

        Target.FormulaR1C1 = "=now()"
        If IsDate(Target) And Target.Value <> "" Then
            For i = 1 To 6
                Target.Offset(0, i).FormulaR1C1 = "=now()"
            Next i
        End If
    End If
    Cancel = True
End Sub


Sorry cathodique. Mais Target.Offset(0, i) remplit les colonnes de gauche à droite.



A+ :cool:
 

job75

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Bonjour Lone-wolf, Regueiro, cathodique,

Essayez :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range
Set c = Cells.Find(Date, , xlValues, xlWhole)
If c Is Nothing Then Exit Sub
Cancel = True
Set c = Cells.Find("", c, , , xlByColumns)
c = Format(Now, "hh:mm")
End Sub
Bonne journée.
 

Lone-wolf

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Bonjour job

la macro est très bien. Mais comme maintenant elle s'applique à la fermeture du classeur, il y a possiblité qu'elle s'arrête une fois atteint la 7ème cellule?


Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim c As Range
With Feuil2
Set c = .Cells.Find(Date, , xlValues, xlWhole)
If c Is Nothing Then Exit Sub
Set c = .Cells.Find("", c, , , xlByColumns)
c = Format(Now, "hh:mm")
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub


Merci pour ton aide


Amicalement Lone-wolf :cool:
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Décaler d'une cellule si cellule est pleine

Re,

Pas compris "la macro s'arrête", sans doute veux-tu ceci :

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim c As Range, c1 As Range
With Feuil2
  Set c = .Cells.Find(Date, , xlValues, xlWhole)
  If Not c Is Nothing Then
    Set c1 = .Cells.Find("", c, , , xlByColumns)
    If c1.Row < c.Row + 8 Then c1 = Format(Now, "hh:mm")
  End If
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
If Workbooks.Count = 1 Then Application.Quit
End Sub
A+
 

job75

XLDnaute Barbatruc
Re : [Résolu par job75] Décaler d'une cellule si cellule est pleine

Re,

Lorsque la 7ème cellule est remplie on peut reprendre au début :

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim c As Range, c1 As Range
With Feuil2
  Set c = .Cells.Find(Date, , xlValues, xlWhole)
  If Not c Is Nothing Then
    Set c1 = .Cells.Find("", c, , , xlByColumns)
    If c1.Row > c.Row + 7 Then c(2).Resize(7) = "": Set c1 = c(2)
    c1 = Format(Now, "hh:mm")
  End If
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
If Workbooks.Count = 1 Then Application.Quit
End Sub
A+
 

Lone-wolf

XLDnaute Barbatruc
Re : [Résolu par job75] Décaler d'une cellule si cellule est pleine

Re job

Et bien, sans vouloir faire de mauvaises remarques; mais quand j'ai fini ma journée, je ne veux pas tout reprendre à zéro si tu comprends ce que je veux dire. ;)


Amicalement Lone-wolf :cool:
 

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 966
Membres
101 852
dernier inscrit
dthi16088