Discussion :

[Pompaero]

Bonjour le forum

Quelques remerciements à l'ensemble du forum pour tout ce que vous faitent pour nous, les petit débutant . qui essayons de faire ade notre mieux.

J'aurai besoin encore un peu d'aide, voilà j'ai un code qui me permet de fusionner des cellules par ligne après les avoir sélectionnées.
Le problème c'est que je peu le faire dans toute la feuille et mon souhait serai de pouvoir le faire seulement dans des emplacement bien précis, comme par ex :

en C12 à AY13
puis C15 à AY16
puis C19 à AY20
ect....
et C40 à AY41.

voiçi mon code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Command1_Click() 'boutton (Astreinte) inscrit Astreinte dans cellule sélectionné
    With Selection
        If .Column >= 2 And .Row >= 2 Then
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .Font.Name = "windgins"
            .Value = Command1.Caption
            .Interior.ColorIndex = 34
        End If
    End With
End Sub

Merçi à vous les pro!!

Cordialement

[DeTraX]

Bonjour,

Essaie avec ce code.

Attention : j'ai supposé que tes plages "conformes" étaient
C12 à AY13
puis C15 à AY16
puis C18 à AY19

... Si l'écart entre les plages n'est pas une constante (variable rowStep), le code ne fonctionnera pas comme tu veux et il faudra faire un tableau de toutes les adresses de plages à tester.

J'ai rajouter une fonctionnalité qui pourra te servir : si le clic est fait en maintenant la touche Shift, les cellules seront "défusionnées", ce qui pourra servir dans le cas d'une faute de frappe où d'une modification.

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
 
Option Explicit
 
Declare Function GetAsyncKeyState Lib "User32" _
            (ByVal vKey As Integer) As Integer
 
Public Sub btnMerge_Clic()
    Dim noRow       As Integer: noRow = 12
    Dim rowStep     As Integer: rowStep = 3
    Dim selectionOK As Boolean
    Dim mergeState  As Boolean
    '
    '-----------------------------------------
    ' Test si majuscule appuyé
    '-----------------------------------------
    If (GetAsyncKeyState(16) <> 0) Then
        mergeState = False
    Else
        mergeState = True
    End If
    '
    With Selection
        Do While noRow <= 40
            If .Row >= noRow And _
               .Row < noRow + rowStep And _
               .Column >= 3 And _
               .Column <= 51 Then
                If .Row + .Rows.Count - 1 >= noRow And _
                   .Row + .Rows.Count - 1 < noRow + rowStep And _
                   .Column + .Columns.Count - 1 >= 3 And _
                   .Column + .Columns.Count - 1 <= 51 Then
                    selectionOK = True
                Else
                    selectionOK = False
                End If
                Exit Do
            End If
            noRow = noRow + rowStep
        Loop
        '
        If Not selectionOK Then
            MsgBox "Selection " & Replace(.Address, "$", "") & " invalide"
        Else
            .MergeCells = mergeState
        End If
    End With
End Sub

[Pompaero]

Bonjour DeTraX,

Merçi pour ta réponse et de t'avoir penché sur ma demande.

Je viens d'essayer ton code mais un msg d'erreur s'affiche :

Erreur de compilation
des constantes, chaines de longueur fixe, tableaux, types définis par l'utilisateur et instructeur Déclare ne sont pas autorisés comme membres Public de modules d'objet.


1)Je ne comprends pas trop bien le code,
Pourrai tu m'expliquer un peu plus ton code dans le détail afin que je comprenne mieux et puisse l'adapter si possible a mon fichier, stp ?

2)A quoi correspond et sert le "User32"

je cherche à comprendre puis evoluer aussi, merci

Je met une piece jointe pour mieux te rendre compte

Cordialement

[DeTraX]

Ton fichier a un peu bougé par rapport à la demande initiale
J'ai adapté

La fonction User32 est un appel à un composant Windows. Il sera utilisé pour savoir si la touche Shift est appuyée, ce que VBA ne sait pas faire
Cette déclaration renvoie une erreur de compilation si on la place dans le code d'une feuille, il faut le faire dans un module.

Dans Feuil1, ta macro appelle une autre fonction qui sera placée dans un module décrit juste après.

Code :

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

1
2
3
4
 
Private Sub CommandButton1_Click()
    MergeCells
End Sub

Ensuite tu crée un nouveau module et tu mets ce code dedans. Je l'ai documenté, j'espère que ça suffira

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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 
Option Explicit
'
Const keyShift = 16     ' Code touche Shift
'
'=========================================================
' Déclaratino d'un composant Windows utilisé pour la
' récupération de la valeur de la touche Shift
' (enfoncée ou pas)
'=========================================================
Declare Function GetAsyncKeyState Lib "User32" _
            (ByVal vKey As Integer) As Integer
 
'
'=========================================================
' Ma fonction de merge / unmerge de la sélection active
'=========================================================
Public Sub MergeCells()
    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 = 1 ' 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)
    '
    '-----------------------------------------
    ' Test si majuscule appuyé
    ' Si c'est le cas
    '   On passe en mode 'défusion'
    ' Sinon
    '   En en mode 'fusion'
    '-----------------------------------------
    If (GetAsyncKeyState(keyShift) <> 0) 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) <> ""
            '
            '----------------------------------------
            ' 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

[Pompaero]

Non du tout, cest certainement moi qui c'est mal exprimé et expliqué, dsl.

Merçi encore d'avoir voulu m'expliquer en détail ton code, je vais le lire et l'étudier puis je te tiens aux news.

Cordialement

RE DeTraX

D'abord grand merçi pour ton code, un vrai pro bravo!!
Ton idée est génial.

Plusieurs intérogations,
de mon coté pour le fusionnement c'est tout à fais ce que je souhaitais, parfais.
Reste juste à ajouter la couleur, le texte, ect... que je vais tenter.

mais pour le défusionnement je partais sur le même principe que la fusion, donc avec un bouton "effacer" à la place de la fonction Shift.
est ce encore possible ?

Concernant les ajouts de couleur, ect... je pense faire ça, est ce que je suis sur la bonne voie ?

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
If (GetAsyncKeyState(keyShift) <> 0) Then
        mergeState = False
'Ajouter ça pour la défusion
'       .Font.Name = ""
'       .Value = ""
'       .Interior.ColorIndex = 19
'       .Borders.Weight = xlThin
    Else
        mergeState = True
'Ajouter ça pour le fusionnement
'       .HorizontalAlignment = xlCenter
'       .VerticalAlignment = xlCenter
'       .Font.Name = "windgins"
'       .Value = Command1.Caption
'       .Interior.ColorIndex = 34
 
    End If
    '
    With Selection

Excuse ça fais beaucoup de choses d'un coup peu etre.
J'exploite ton code à fond , il me plait fortement merçi.

Cordialement

[DeTraX]

C'est assez facile d'adapter le code pour gérer 2 boutons.
Le plus simple c'est de passer un paramètre à la fonction.

Dans le code de la feuille, chaque bouton appelle la fonction avec en paramètre l'action à exécuter

Code :

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

1
2
3
4
5
6
7
8
9
10
 
' Pour le bouton Grouper
Private Sub CommandButton1_Click()
    MergeCells "Grouper"
End Sub
 
' Pour le bouton Dégrouper
Private Sub CommandButton2_Click()
    MergeCells "Dégrouper"
End Sub

Dans la fonction, tu peux supprimer les lignes suivantes (et les commentaires associés),

Code :

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

1
2
3
4
5
 
Const keyShift = 16     ' Code touche Shift
 
Declare Function GetAsyncKeyState Lib "User32" _
            (ByVal vKey As Integer) As Integer

... modifier la déclaration de la fonction

Code :

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

1
2
Public Sub MergeCells(action As String)

et remplacer

Code :

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

1
2
 
    If (GetAsyncKeyState(keyShift) <> 0) Then

par

Code :

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

1
2
 
    If action = "Dégrouper" Then

Pour ce qui est de la mise en forme, je te conseille de te limiter à la couleur de fond et à l'affichage ou non de la grille. Pour la police, par exemple, conserve celle de la feuille. A la limite tu changes la police dans la feuille à la main, mais la changer par macro n'apportera pas grand chose.

Et dis toi que chaque propriété que tu modifies en groupant des cellules doit être remise à son état initial quand tu les dégroupes...