PB de rédaction de condition dans des plages flottantes

**jokobugs** · 16/12/2014, 16h18

Bonjour à tous.

Je recherche une formulation de condition pour exécution d'une macro.

La condition est la suivante :

je lance une macro exécutable par bouton suivant la position du curseur.
et pour pouvoir l'exécuté, je veut vérifié que la ligne ou ce trouve le curseur est bien comprise entre deux ligne haute et basse.

Dans la ligne haute fixe une cellule est nommé si besoin ou avec une contenu.
Dans la ligne basse variable une cellule est nommé si besoin ou avec une contenu.

Voici pour précision mon tableau

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
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
Sub supp_ligne_2()
 
    Dim i As Integer
    Dim j As Integer
    Dim k As Range
    Dim l As Range
    Dim m As Range
 
 
    ActiveSheet.Unprotect
    i = ActiveCell.Row
    j = i - 1
 
    If ActiveSheet.Name <> "Etude" And ActiveSheet.Name <> "Etude opt" Then
    MsgBox ("Selection non valide pour cette opération")
    Else:
 
    k = Cells("Deb").Row
    l = Cells("Fin").Row
 
    If i < k And i > l Then
    MsgBox ("Selection non valide pour cette opération")
    Else:
 
    Rows(i & ":" & i).Delete Shift:=xlUp
    Range("B" & j).Select
 
    'une erreur de mise en page apparait si l'action ce passe sous un chapitre
    'remise en forme si sous chapitre
    If ((Range("B" & j).Font.Bold = True) And (Range("B" & j).Interior.ColorIndex = 34)) Then
 
    With Range("B" & j & ":P" & j)
    With .Font
         .Bold = True
         .ColorIndex = 3
    End With
    With .Borders(xlEdgeTop)
         .LineStyle = xlDouble
         .Weight = xlThick
         .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .Weight = xlThick
         .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeRight)
         .LineStyle = xlDouble
         .Weight = xlThick
         .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeLeft)
         .LineStyle = xlDouble
         .Weight = xlThick
         .ColorIndex = xlAutomatic
    End With
    With .Interior
         .ColorIndex = 34
         .Pattern = xlSolid
         .PatternColorIndex = 49
    End With
    Range("B" & j).Font.ColorIndex = 1
    End With
 
    End If
 
    Range("B" & i).Select
 
    End If
    ActiveSheet.Protect , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    End If
End Sub

Pour illustration de mon fichier:
Doc1.doc

Merci pour votre aide et votre temps.

Crdl

Invité · 17/12/2014, 06h41

Bonjour,

Une solution dans le fichier joint.

Le module standard contient le code suivant :

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
Option Explicit
 
Sub SuppressionDeLigne()
 
Dim LigneASupprimer As Long
Dim ColonneActivecell As Long
Dim LigneASupprimerMoins1 As Long
Dim LigneDebut As Long
Dim LigneFin As Long
 
Dim Continuer As Boolean
 
    With ActiveSheet
 
        .Unprotect
 
        Continuer = True
 
        If .Name <> "Etude" And .Name <> "Etude opt" Then
                MsgBox "Seuls les onglets Etude ou Etude opt sont valides pour cette opération, fin de programme !", _
                    vbCritical, "Vérification du nom de l'onglet"
 
                Continuer = False
        End If
 
 
        LigneDebut = RechercherLignesDebutOuFin("Deb")
        LigneFin = RechercherLignesDebutOuFin("Fin")
 
        If LigneDebut = 0 Or LigneFin = 0 Then
                MsgBox "Ligne début : " & LigneDebut & ", ligne fin : " & LigneFin _
                        & Chr(10) & "Les limites début et fin ne sont pas fixées, fin de programme !", _
                        vbCritical, "Vérification des limites"
 
                Continuer = False
       End If
 
       With ActiveCell
            LigneASupprimer = .Row
            ColonneActivecell = .Column
            LigneASupprimerMoins1 = LigneASupprimer - 1
       End With
 
       If LigneASupprimer < LigneDebut Or LigneASupprimer > LigneFin Then
                MsgBox "La ligne à supprimer est hors des limites, fin de programme !", _
                vbCritical, "Contrôle de la position de la ligne à supprimer"
 
                Continuer = False
       End If
 
       If Continuer = True Then
 
             .Rows(LigneASupprimer).Delete Shift:=xlUp
 
             'Remise en forme si sous chapitre
             If .Range("B" & LigneASupprimerMoins1).Font.Bold = True And .Range("B" & LigneASupprimerMoins1).Interior.ColorIndex = 34 Then
                   MiseEnFormeLigneChapitre .Range("B" & LigneASupprimerMoins1 & ":P" & LigneASupprimerMoins1)
             End If
 
            .Cells(LigneASupprimer, ColonneActivecell).Activate
 
       End If
 
        .Protect , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
 
    End With
 
End Sub
 
Function RechercherLignesDebutOuFin(ByVal MotRecherche As String) As Long
 
Dim CellRecherchee As Range
 
    RechercherLignesDebutOuFin = 0
    Set CellRecherchee = Cells.Find(What:=MotRecherche, LookIn:=xlValues)
    If Not CellRecherchee Is Nothing Then RechercherLignesDebutOuFin = CellRecherchee.Row
    Set CellRecherchee = Nothing
 
 
End Function
 
 
Sub MiseEnFormeLigneChapitre(ByVal AireBordure As Range)
 
Dim PositionBordure As Variant
Dim CtrI As Integer
 
    With AireBordure
 
         With .Font
              .Bold = True
              .ColorIndex = 3
         End With
 
         With .Interior
              .ColorIndex = 34
              .Pattern = xlSolid
              .PatternColorIndex = 49
         End With
 
         PositionBordure = Array(xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlEdgeLeft)
 
         For CtrI = LBound(PositionBordure) To UBound(PositionBordure)
             With .Borders(PositionBordure(CtrI))
                  .LineStyle = xlDouble
                  .Weight = xlThick
                  .ColorIndex = xlAutomatic
            End With
         Next CtrI
    End With
 
     AireBordure(1, 1).Font.ColorIndex = 1
 
End Sub

Le module de la feuille Etude contient le code suivant :

Code :

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

1
2
3
4
5
6
7
8
Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal CelluleLigneASupprimer As Range, Cancel As Boolean)
 
    SuppressionDeLigne
    Cancel = True
 
End Sub

Un double clic sur la ligne lance le programme de suppression.

Cordialement.

**jokobugs** · 17/12/2014, 10h05

Bonjour,

Merci pour cette aide, cela m'a été très utile.

je me posais une question concernant votre façon d'écrire les macros, allège-t-elle le poids du fichier au final ou Est-ce équivalent?

merci encore.

Invité · 17/12/2014, 10h29

Envoyé par jokobugs

je me posais une question concernant votre façon d'écrire les macros, allège t'elle le poids du fichier au final ou Est-ce équivalent?

Bonjour,

Le poids du fichier envoyé est lié aux captures d'écran. Le poids du code VBA lui-même est marginal.

Pour la maintenance de vos outils, pensez à rendre très explicite le nom de vos variables et à subdiviser vos routines. Si en plus vous passez en paramètres les éléments nécessaires au fonctionnement de vos sous-routines, la maintenance sera encore plus facile.

Cordialement.

**jokobugs** · 17/12/2014, 18h06

Bonjour,

je voudrai un complément si possible d'information sur le sujet je voudrais permettre la même chose avec une colonne de fin, cela marche mais revois une valeur numérique dans

Code :

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

Columns("A:" & i).EntireColumn.Hidden = False

en procédant de cette façon :

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
Sub fin_saisie_2()
    ' Fin_saisie Macro
    ' Macro enregistrée le 14/06/99 par DV
    Dim monObjet As Range
    Dim i As String
 
    Application.ScreenUpdating = False
 
    i = ColonneFinale("CFin")
 
    If ActiveSheet.Name <> "Etude" And ActiveSheet.Name <> "Etude opt" Then
        MsgBox "Selection non valide pour cette opération", vbCritical
    Else:
        ActiveSheet.Unprotect
        Set monObjet = ActiveCell
        Columns("A:" & i).EntireColumn.Hidden = False
        Rows("1:4").EntireRow.Hidden = False
        Range("J7").Select
        ActiveWindow.FreezePanes = False
        monObjet.Select
        ActiveSheet.Protect , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    End If
 
    Application.ScreenUpdating = True
 
End Sub
 
 
Function ColonneFinale(ByVal MotRecherche As String) As Long
 
Dim i As Range
 
    ColonneFinale = 0
    Set i = Cells.Find(what:=MotRecherche, LookIn:=xlValues)
    If Not i Is Nothing Then ColonneFinale = i.Column
    Set i = Nothing
 
End Function

Merci par avance du temps passé.

merci.

CRDL

Invité · 17/12/2014, 18h27

Envoyé par jokobugs

Bonjour,

Code :

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

Columns("A:" & i).EntireColumn.Hidden = False

Dim I est de type Long et non String dans :

Code :

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

1
2
3
4
5
Sub fin_saisie_2()
    ' Fin_saisie Macro
    ' Macro enregistrée le 14/06/99 par DV
    Dim monObjet As Range
    Dim i As String

La syntaxe de Columns("A:" & i).EntireColumn.Hidden = False n'est pas bonne
Columns("A:" & i) doit faire référence à des nombres entiers Columns("1:" & i) et Hidden se suffit à lui-même : Columns("1:" & i).Hidden = false.
Sinon, il faut utiliser la syntaxe Range("A:" & i).EntireColumn.Hidden = False.

Ce n'était pas la peine de remplacer la variable CellRecherchee par I dans la fonction.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Function ColonneFinale(ByVal MotRecherche As String) As Long
 
Dim CellRecherchee As Range
 
    ColonneFinale = 0
    Set CellRecherchee  = Cells.Find(what:=MotRecherche, LookIn:=xlValues)
    If Not CellRecherchee Is Nothing Then ColonneFinale = CellRecherchee.Column
    Set CellRecherchee  = Nothing
 
End Function

Voir les notions de variable et leur déclaration.

Cordialement.

PB de rédaction de condition dans des plages flottantes

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager