Discussion :

[Pompaero]

bonjour le forum

je souhaiterai un peu d'aide svp.

Si cela est possible bien sur,
j'aimerai récupérer dans ma sélection de cellules l'heure de début et l'heure de fin.
Ma particularité est que mes heures que je souhaite notifier sont sur les lignes au dessus de ma sélection.

J'ai bien chercher sur le net et les forum mais pas trouvé pour mon cas c'est pour cela que je me rapproche de vous.

Je vous mets un fichier en modèle.

Cordialement

[Ashireon]

Hello

Avec Offset tu peux pointer une cellule par rapport a celle selectionnée

Genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Cells(1,1).offset(10,4).value

pointe la valuer de la cellule en D11 vu que qu'on part de A1.
Donc on peut remonter en faisant aussi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(10,10).offset(-4,2).select

on part de J10 avec offset on va sellectionner en F12 par exemple..

Etc..

Je viens de regarder ton fichier.
Donc il faut detecter le debut et la fin d'une fusion de cellule.
Et donc renvoyer en texte les heures en value à l'interieur.
Un bon casse tête pour ce soir. :-)

[patricktoulon]

Bonjour
pour une solution la plus simple repérer les cellules de couleures verte
pour une solution un peu plus elaborée rechercher les cellules fusionnées

fair une recherche du coté
allez une piste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub heures()
 
With Sheets(1)
For lig = 7 To Range("a" & Rows.Count).End(xlUp).Row Step 7
plage = "b" & i & ":ax" & i
oldadresse = ""
For col = 2 To .Range("ax1").Column - 1
 
      If InStr(Cells(lig, col).MergeArea.Address, ":") > 0 And oldadresse <> Cells(lig, col).MergeArea.Address Then
oldadresse = Cells(lig, col).MergeArea.Address
MsgBox Cells(lig, col).MergeArea.Address
 
 End If
 
Next
Next
End With
End Sub

[Pompaero]

Hello Ashireon et patricktoulon

Merci de vos reponses aussi rapide, je viens d'essayer vos propositions mais comme dit Ashireon un vrai casse tête !!
Je crois que je m'engage dans qql chose de délicat.

Pour le moment rien ne marche

je continu de chercher.

Cordialment

[_C14_]

Voici un code qui doit être fonctionnel, il suffit de nommer une feuille W et à ce stade envoyer le num de ligne manuellement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
Option Explicit
'DCL LE NOM DE FEUILLE
Public Const NomF As String = "W"
 
'DCL LA DUREE MAXIMUM SUR UN JOUR EN HEURE
Public Const Max As Integer = 24
 
'DCL LES BORNAGES
Public Const Debut As Integer = 2
Public Const Fin As Integer = 50
 
'DCL LE NB DE COLONNES DE LA PLAGE
Public Const NB_COL As Integer = 12
 
'DCL LA COULEUR
Public Const GreenColor As Long = 5296274
 
Public Sub FAIRE_TEST()
Call Lecture(7)
End Sub
 
'LECTURE D'UNE LIGNE
Public Sub Lecture(Num_Ligne As Integer)
 
'DCL les variables locales
Dim c As Integer
Dim CUMUL As Double
 
'DCL LES OBJETS
Dim ws As Worksheet: Set ws = Application.Sheets(NomF)
    With ws
        .Activate
            For c = Debut To Fin
                If TestCOLOR(ws, Num_Ligne, c) = True Then '
                CUMUL = CUMUL + 0.5
    '            MsgBox "retour OK"
                End If
            Next c
    MsgBox " CUMUL = " & CUMUL
    End With
Set ws = Nothing
 
End Sub
 
 
Public Function TestCOLOR(ws As Worksheet, Num_Ligne As Integer, c As Integer) As Boolean
    With ws.Cells(Num_Ligne, c)
        .Activate
        With Selection.Interior
            If Selection.Interior.Color = GreenColor Then
                TestCOLOR = True
                Else
            TestCOLOR = False
            End If
        End With
    End With
End Function

Par contre qlqs rqs si je puis me permettre sur la démarche générale du traitement :

• travailler sur des plages fusionnées avec du code est assez périlleux !
• le fait d'avoir X informations (c'est à dire avoir une plage 1 puis une plage 2) sur la même ligne va sérieusement compliquer le code, d'ailleurs le code fourni ne s'attaque pas à ce problème (cependant cela reste possible ...),

En fait je prendrais le schéma inverse c'est à dire saisir une plage pour un jour et une personne. Ensuite réaliser un traitement graphique pour présenter les données visuellement, bien cordialement.

[patricktoulon]

Re

allez juste pour le fun
si tu analyse le code tu verra que ca n'est pas si compliqué que ca
pour commencer je te propose d'ajouter les heures et demie heures dan la ligne 1 qui te sert a rien quitte a la masquer par la suite

comme ceci a partir de la colonne "B" (2 colonne) au format texte si possible

06:00!06:30!07:00!07:30! ect.....

ensuite avec la methode de détection des cellules fusionnée dans une ligne
tu récupère la colonne de la plage fusionnée et la dernière

ensuite avec ligne 1 et colonne tu a l'heure de debut et de fin

regarde ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub marque_les_heures_debut_fin()
    With Sheets(1)
        For lig = 7 To Range("a" & Rows.Count).End(xlUp).Row Step 7
            For e = 0 To 1
                debut = ""
                oldadresse = ""
                fin = ""
                For col = 2 To .Range("ax1").Column - 1
                    If InStr(Cells(lig + e, col).MergeArea.Address, ":") > 0 And oldadresse <> Cells(lig + e, col).MergeArea.Address Then
                        oldadresse = Cells(lig + e, col).MergeArea.Address
                        If debut = "" Then debut = Cells(1, Range(Split(Cells(lig + e, col).MergeArea.Address, ":")(0)).Column)
                        fin = Cells(1, Range(Split(Cells(lig + e, col).MergeArea.Address, ":")(1)).Column + 1)
                    End If
                Next
                Range("ay" & lig + e) = debut
                Range("az" & lig + e) = fin
            Next e
        Next lig
    End With
End Sub

comme tu peux le voir il n'y a pas beaucoup de code pour y parvenir

je regarde maintenant pour faire le cumul car si il y a coupure entre deux vacations pour le calcul du total d'heure il faudra prendre en compte cette coupure

Au plaisir

Re
j'ai ajouté 2!! lignes de code pour le cumul s des heures de la journéé pour chaques noms

voila le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Sub marque_les_heures_debut_fin()
    With Sheets(1)
        For lig = 7 To Range("a" & Rows.Count).End(xlUp).Row Step 7
            For e = 0 To 1
                debut = ""
                oldadresse = ""
                fin = ""
                temps = 0
                For col = 2 To .Range("ax1").Column - 1
                    If InStr(Cells(lig + e, col).MergeArea.Address, ":") > 0 And oldadresse <> Cells(lig + e, col).MergeArea.Address Then
                        oldadresse = Cells(lig + e, col).MergeArea.Address
                        If debut = "" Then debut = Cells(1, Range(Split(Cells(lig + e, col).MergeArea.Address, ":")(0)).Column)
                        fin = Cells(1, Range(Split(Cells(lig + e, col).MergeArea.Address, ":")(1)).Column + 1)
                    temps = temps + Range(Cells(lig + e, col).MergeArea.Address).Columns.Count / 2
                    MsgBox temps
                    End If
                        Next
                Range("ba" & lig + e) = temps
                Range("ay" & lig + e) = debut
                Range("az" & lig + e) = fin
 
            Next e
        Next lig
    End With
End Sub

et voila emballez c'est pesé
Au plaisir

[Pompaero]

Re
bonjour Patrick

grand merci pour votre aide, cela me permet d'apprendre encore plein de nouvelles choses, c'est .

Après analyse de ton code, je me pose la question de savoir ou le mettre sachant que j'ai déjà construit mon fichier (l'histoire de noter les heures était un luxe pour moi, si cela était possible) à priori c'est possible alors je me lance.

Donc pour moi j'ajouterai ton code à mon bouton (Command1)qui permet de fusionner, est ce correct ?

Code du bouton:
sur feuille 3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Command1_Click() 'Bouton dispo pour fusionner
    MergeCells "Grouper"
 Range("Q7").Select
End Sub
 
Private Sub Command2_Click() 'Bouton éffacer pour défusionner
    MergeCells "Dégrouper"
 Range("Q7").Select
End Sub

Code du module correspondant:
je te laisse les commentaires pour mieux comprendre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Option Explicit
'=========================================================
' Ma fonction de merge / unmerge de la sélection active
'=========================================================
Public Sub MergeCells(action As String)
    Dim noRow       As Integer: noRow = 12    ' première ligne plage traitée (commence en ligne 12)
    Dim rowStep     As Integer: rowStep = 6   ' Nb lignes entre 2 plages
    Dim rowHeight   As Integer: rowHeight = 2 ' Hauteur de ligne fusionable
    Dim selectionOK As Boolean                ' Selection conforme ou pas
    Dim mergeState  As Boolean                ' Fusion (true) ou 'défusion' (false)
    Dim colMin      As Integer: colMin = 3    ' Première colonne de planning (C)
    Dim colMax      As Integer: colMax = 51   ' Dernière colonne de planning (AY)
    '-----------------------------------------
    If action = "Dégrouper" Then
        mergeState = False
    Else
        mergeState = True
    End If
    '
    With Selection
        '----------------------------------------
        ' Boucle de traitement sur toutes les dates saisies
        ' Commence à traiter la ligne 12, puis 18 (12 + 6) puis 24 (18 + 6), ...
        ' Continue tant que la colonne 2 de la ligne traitée n'est pas vide
        '----------------------------------------
        Do While ActiveSheet.Cells(noRow, 2) <> ""
 
            If mergeState = False Then
              .Interior.ColorIndex = 19
              .Borders.Weight = xlThin
            Else
             If mergeState = True Then
               .Interior.Color = RGB(0, 255, 96) '43
             End If
            End If
            '----------------------------------------
            ' Si la le coin supérieur gauche de la sélection est dans la zone de planning
            '----------------------------------------
            If .Row >= noRow And _
               .Row <= noRow + rowHeight And _
               .Column >= colMin And _
               .Column <= colMax Then
                '----------------------------------------
                ' Si la le coin inférieur droit de la sélection est aussi dans la zone de planning
                '----------------------------------------
                If .Row + .Rows.Count - 1 >= noRow And _
                   .Row + .Rows.Count - 1 < noRow + rowHeight And _
                   .Column + .Columns.Count - 1 >= colMin And _
                   .Column + .Columns.Count - 1 <= colMax Then
                   '--------------------------------------
                   ' ... Alors la sélection est valide et peut être traitée
                   '--------------------------------------
                    selectionOK = True
                Else
                   '--------------------------------------
                   ' Sinon la sélection déborde de la zone de planning et ne doit pas être traitée
                   '--------------------------------------
                    selectionOK = False
                End If
                '------------------------------------------
                ' Dans tous les cas, si on arrive à ce point,on sort de la boucle car aucune autre date ne peut correspondre à la sélection
                '------------------------------------------
                Exit Do
            End If
            '----------------------------------------------
            ' On passe à la date de planning suivante avant de boucler
            '----------------------------------------------
            noRow = noRow + rowStep
        Loop
        '---------------------------------------------------
        ' Si la plage sélectionnée n'était pas dans une zone de planning, message d'erreur sur la plage sélectionnée
        '---------------------------------------------------
        If Not selectionOK Then
 
            MsgBox "Selection " & Replace(.Address, "$", "") & " invalide"
        '---------------------------------------------------
        ' Sinon on traite la plage en groupant ou dégroupant les cellules
        '---------------------------------------------------
        Else
            .MergeCells = mergeState
        End If
    End With
End Sub

Je continu les essais et merci encore

Cordialement

[patricktoulon]

Allez un e 3 eme version qui va te plaire

1 dans ton fichier enlève lui tout code dans tout module

2 ouvre le module thisworkbook et met ceci dedans :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Application.CommandBars("cell").Reset
End Sub
 
Private Sub Workbook_Open()
ajoutdansbarre
End Sub

maintenant ajoute un module standard et met lui ceci dedans

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
 
Public bout1 As Object
Public bout2 As Object
 
Sub ajoutdansbarre()
    Application.CommandBars("cell").Reset
    Dim MyMenu As Object
    Set MyMenu = Application.ShortcutMenus(xlWorksheetCell).MenuItems.AddMenu("Planification", 1)
    With MyMenu.MenuItems
        'ajout "nom du bouton",macro associée,   , emplacement du bouton,
        Set bout1 = .Add("Planifier", "fusion_ou_pas", , 1, "")
        Set bout2 = .Add("Déplanifier", "fusion_ou_pas", , 2, , "")
    End With
    Set MyMenu = Nothing
End Sub
 
Sub fusion_ou_pas()
    If Selection.Rows.Count > 1 Then
    MsgBox "Veuillez selectionner les heures sur une seule ligne SVP"
    Exit Sub
    End If
    ligneautorisée = "7:8:14:15:21:22"
    If InStr(ligneautorisée, Selection.Row) > 0 Then
 
        Select Case CommandBars.ActionControl.Caption
 
        Case "Planifier"
            Selection.MergeCells = True
            Selection.Interior.Color = vbGreen
            Selection.Borders.LineStyle = xlContinuous
'Selection.Borders(xlInsideVertical).LineStyle = xlNone
            'Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
        Case "Déplanifier"
          Selection.Value = ""
             Selection.Interior.Color = xlNone
            Selection.MergeCells = False
            Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
            Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
            Selection.Borders.LineStyle = xlContinuous
 
        End Select
    End If
    marque_les_heures_debut_fin
End Sub
Sub marque_les_heures_debut_fin()
    heures = Array(1, 1, "06:00", "06:30", "07:00", "07:30", "08:00", "08:30", "09:00", "09:30", "10:00", "10:30", "11:00", "11:30", "12:00", "12:30", "13:00", "13:30", _
                   "14:00", "14:30", "15:00", "15:30", "16:00", "16:30", "17:00", "17:30", "18:00", "18:30", "19:00", "19:30", "20:00", "20:30", "21:00", "21:30", "22:00", "22:30", _
                   "23:00", "23:30", "00:00", "00:30", "01:00", "01:30", "02:00", "02:30", "03:00", "03:30", "04:00", "04:30", "05:00", "05:30", "06:00")
    lig = Selection.Row
        debut = ""
        oldadresse = ""
        fin = ""
        temps = 0
      With Sheets(1)
          For col = 2 To .Range("ax1").Column + 2
            If InStr(Cells(lig, col).MergeArea.Address, ":") > 0 And oldadresse <> Cells(lig, col).MergeArea.Address Then
                oldadresse = Cells(lig, col).MergeArea.Address
                If debut = "" Then debut = heures(Range(Split(Cells(lig, col).MergeArea.Address, ":")(0)).Column)
                fin = heures(Range(Split(Cells(lig, col).MergeArea.Address, ":")(1)).Column + 1)
                temps = temps + Range(Cells(lig, col).MergeArea.Address).Columns.Count / 2
              End If
        Next
        Range("ba" & lig) = temps
        Range("ay" & lig) = debut
        Range("az" & lig) = fin
    End With
End Sub

enregistre le fichier comme ca et réouvre le
desormais au clic droit apres avoir selectionné une plage de cellulle sur les les lignes des noms
tu aura dans le menu contextuel un menu "Planification"
dans ce menu planification tu aura 2 items
planifier et déplanifier
ces boutons feront exactement ce que leur nom indiquent
le calcul de debut et fin puis total d'heure se fera dynamiquement

je me suis bien amuser avec ca
Au plaisir