XL 2019 Macro - Code endommagé

D

DUPONTMARION

XLDnaute Nouveau
Bonjour,

Dans le fichier joins, dans la feuille "EVALUATION DES RISQUES" j'ai deux macro qui ne fonctionnent plus car j'ai ajouté des colonnes dans le fichier que j'ai surligné en jaune fluo, pourriez vous m'aider à réparer le code ? je vous remercie.
 

Pièces jointes

  • RH à remettre v3.xlsm
    147.3 KB · Affichages: 8
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Bonjour
si tu ajoutes des colonnes , il faut adapter (et non corriger) ton code
si j'ai bie compris, tu as ajouté deux colonnes en E et F==> donc les colonnes E et F Avant insertion sont devenues G et H
G est devenue I
H est devenue J....
ce qui donnerait ce nouveau code..
note: utiliser la lettre l (L) comme indice n'est pas une bonne idée.. parce que visuellemnent, ca ressemble beaucoup au 1..
j'ai donc remplacé par lig
VB: 
Sub InsérerLigne()

'MsgBox Range("d25").Value
 lig = Selection.Row

ActiveSheet.Unprotect

If lig = 0 Then
    MsgBox "Aucune Sélection - Veuillez sélectionner la dernière ligne du tableau où vous souhaitez ajouter une situation dangereuse."
Else
    maval = Range("H" & lig).Value
    If maval <> 0 And maval <> 1 And maval <> 8 And maval <> 27 And maval <> 64 Or maval = "" Then
        MsgBox "Sélection erronée - Vous ne pouvez insérer une situation dangereuse à cet endroit."
    Else
        Selection.EntireRow.Insert
        Range("H" & lig + 1 & ":O" & lig + 1).Select
        Selection.Copy
        Range("H" & lig).Select
        ActiveSheet.Paste
        Range("a" & lig).Value = ""
        Range("b" & lig).Value = ""
        Range("c" & lig).Value = ""
        Range("d" & lig).Value = ""
        Range("G" & lig).Value = ""
        Range("H" & lig).Value = "Non renseigné"
        Range("K" & lig).Value = "Non renseigné"
        Range("M" & lig).Value = "Non renseigné"
        '  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True
    End If
End If
End Sub
 
Vote positif 0 Vote négatif
D

DUPONTMARION

XLDnaute Nouveau
vgendron à dit:
Bonjour
si tu ajoutes des colonnes , il faut adapter (et non corriger) ton code
si j'ai bie compris, tu as ajouté deux colonnes en E et F==> donc les colonnes E et F Avant insertion sont devenues G et H
G est devenue I
H est devenue J....
ce qui donnerait ce nouveau code..
note: utiliser la lettre l (L) comme indice n'est pas une bonne idée.. parce que visuellemnent, ca ressemble beaucoup au 1..
j'ai donc remplacé par lig
VB: 
Sub InsérerLigne()

'MsgBox Range("d25").Value
 lig = Selection.Row

ActiveSheet.Unprotect

If lig = 0 Then
    MsgBox "Aucune Sélection - Veuillez sélectionner la dernière ligne du tableau où vous souhaitez ajouter une situation dangereuse."
Else
    maval = Range("H" & lig).Value
    If maval <> 0 And maval <> 1 And maval <> 8 And maval <> 27 And maval <> 64 Or maval = "" Then
        MsgBox "Sélection erronée - Vous ne pouvez insérer une situation dangereuse à cet endroit."
    Else
        Selection.EntireRow.Insert
        Range("H" & lig + 1 & ":O" & lig + 1).Select
        Selection.Copy
        Range("H" & lig).Select
        ActiveSheet.Paste
        Range("a" & lig).Value = ""
        Range("b" & lig).Value = ""
        Range("c" & lig).Value = ""
        Range("d" & lig).Value = ""
        Range("G" & lig).Value = ""
        Range("H" & lig).Value = "Non renseigné"
        Range("K" & lig).Value = "Non renseigné"
        Range("M" & lig).Value = "Non renseigné"
        '  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True
    End If
End If
End Sub
Cliquez pour agrandir...
Bonjour,
Merci beaucoup, ça ne fonctionne pas. J'ai tout cassé je crois ahah, lorsque j'appuie sur le bouton Pré-saisie du plan d'actions rien ne va ^^
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

DUPONTMARION à dit:
Dans le fichier joins, dans la feuille "EVALUATION DES RISQUES" j'ai deux macro qui ne fonctionnent plus car j'ai ajouté des colonnes dans le fichier que j'ai surligné en jaune fluo, pourriez vous m'aider à réparer le code ?
Cliquez pour agrandir...

Je te propose ceci :
VB: 
Sub InsérerLigne()
' InsérerLigne Macro

'    MsgBox Range("d25").Value
    Lig = Selection.Row
'    MsgBox Lig
    ActiveSheet.Unprotect

    'If ActiveCell.Row = 0 Then
    If Lig = 0 Then

        MsgBox "Aucune Sélection - Veuillez sélectionner la dernière ligne du tableau où vous souhaitez ajouter une situation dangereuse."

    Else

        maval = Range("J" & l).Value
'        MsgBox maval
        If maval <> 0 And maval <> 1 And maval <> 8 And maval <> 27 And maval <> 64 Or maval = "" Then

            MsgBox "Sélection erronée - Vous ne pouvez insérer une situation dangereuse à cet endroit."

        Else

            Selection.EntireRow.Insert

            Range("H" & Lig + 1 & ":O" & Lig + 1).Copy
            Range("H" & Lig).Paste

            Range("A" & Lig).Value = ""
            Range("B" & Lig).Value = ""
            Range("C" & Lig).Value = ""
            Range("D" & Lig).Value = ""
            Range("G" & Lig).Value = ""
            Range("I" & Lig).Value = "Non renseigné"
            Range("K" & Lig).Value = "Non renseigné"
            Range("M" & Lig).Value = "Non renseigné"

'            ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, AllowDeletingRows:=True

        End If

    End If

ps : j'ai remplacé la variable "l" par "Lig" car je n'arrivais pas à différencier le "L" du "1"...

pps : il me paraît impossible que Lig soit égal à zéro, puisqu'il y a forcément une cellule active et que sa ligne est forcément supérieure ou égale à 1.

ppps : avec un tableau structuré et donc des noms de colonnes, tu n'aurais pas de problème en cas d'ajout de nouvelles colonnes. ;)


[edit]
vgendron à dit:
note: utiliser la lettre l (L) comme indice n'est pas une bonne idée.. parce que visuellemnent, ca ressemble beaucoup au 1..
j'ai donc remplacé par lig
Cliquez pour agrandir...
Oups... je n'avais point vu... 😔
Mais au moins, nous sommes d'accord. ;)
[/edit]
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Je suis en train de regarder la deuxième macro.

Est-ce que la partie "Copier/coller cotation" qui copie la colonne M ne devrait pas en fait copier la nouvelle colonne E ???
La cellule M4 faisant partie d'un groupe de cellules fusionnées, la copie de la colonne M copie en fait les colonnes i à o...

Même question pour la copie de la colonne N qui serait plutôt la colonne G actuelle.
Et même problème de cellules fusionnées...
La fusion, c'est la Mal !
 
Dernière édition:
Vote positif 0 Vote négatif
D

DUPONTMARION

XLDnaute Nouveau
TooFatBoy à dit:
Je suis en train de regarder la deuxième macro.

Est-ce que la partie "Copier/coller cotation" qui copie la colonne M ne devrait pas en fait copier la nouvelle colonne E ???
La cellule M4 faisant partie d'un groupe de cellules fusionnées, la copie de la colonne M copie en fait les colonnes i à o...

Même question pour la copie de la colonne N qui serait plutôt la colonne G actuelle.
Et même problème de cellules fusionnées...
La fusion, c'est la Mal !
Cliquez pour agrandir...
Oui clairement, oui l'idée est bonne merci, j'ai pu avancée, je n'ai qu'un seul élément qui me bloque encore c'est la colonne F "solutions retenues"... je ne vois pas comment elle est alimentée ^^ mais je cherche, merci beaucoup
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
à Noter que
VB: 
    '*** Copier/coller unités et phases: Cols A etB
    ShEval.Range("A4:B" & Lastline).Copy Destination:=.Range("B4")

    '*** Copier/coller Situation dangereuse ColC
    ShEval.Range("C4:C" & Lastline).Copy Destination:=.Range("D4")

    '*** Copier/coller risques Col D
    ShEval.Range("D4:D" & Lastline).Copy Destination:=.Range("E4")

peut etre remplacé/simplifié par
VB: 
    '*** Copier/coller unités et phases: Cols A etB
    ShEval.Range("A4:D" & Lastline).Copy Destination:=.Range("B4")
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
et pour les problèmes de lignes vides copiées en début de feuille..
d'où ma question: en plus des colonnes insérées, n'aurais tu pas aussi inséré des lignes?
VB: 
Sub Creer_Plan_Actions_Prevention()

Dim nbSheet, l  As Integer
Dim mySheet As Integer
Dim myName As String
Dim ShEval As Worksheet

Set ShEval = ActiveWorkbook.Sheets("EVALUATION DES RISQUES")
Lastline = ShEval.Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la feuille
'Ajout d'une feuille
    'Récupérer le nombre de feuilles
     nbSheet = Sheets.Count
     mySheet = nbSheet + 1
     myName = "PLAN D'ACTIONS PREVENTION (" & mySheet & ")"
    '****************************************************************
    
    ' *** Copier la feuille "plan d'actions" et la coller à la fin
    Worksheets("PLAN D'ACTIONS  PREVENTION Vide").Visible = True
    
    Sheets("PLAN D'ACTIONS  PREVENTION Vide").Copy After:=Sheets(nbSheet)
    Sheets(mySheet).Name = myName
    '****************************************************************
    
With Sheets(myName)
     ' *** Récupérer les données
    '*** Copier/coller unités et phases: Cols A etB
    ShEval.Range("A7:D" & Lastline).Copy Destination:=.Range("B4")

  
    '*** Copier/coller cotation Col O
    ShEval.Range("O7:O" & Lastline).Copy
    .Range("A4").Select
    'collage spécial
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    '*** Copier/coller prévention Col G
    ShEval.Range("G7:G" & Lastline).Copy Destination:=.Range("F4")

    '****************************************************************
  
    '*** faire un joli cadre
    'rechercher depuis la fin la premiere cellule non vide de la colonne K
    Lastline = Range("A" & Rows.Count).End(xlUp).Row

    Set zone = .Range("A4:I" & Lastline)
    With zone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    With zone.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With zone.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With zone.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With zone.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With zone.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With zone.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    '*********************************************************************************
    Worksheets("PLAN D'ACTIONS  PREVENTION Vide").Visible = False
End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

3
  • Question
XL 2021 erreur sur formule qui ne se met pas correctement à jour
Réponses
3
Affichages
228
JHA
J
L
  • Question
Microsoft 365 formule décaler avec pourcentage selon les mois
Réponses
5
Affichages
257
l.et.lilou
L
N
  • Question
Autres macro couleurs
Réponses
4
Affichages
426
Ninimam
N
L
  • Question
XL 2021 Filtres et tris qui ne fonctionnent pas après exécution d'une macro
Réponses
9
Affichages
261
Compte Supprimé 979
C
Z
  • Résolu(e)
XL 2016 VBA Outlook avec pj et extrait tableau
Réponses
1
Affichages
373
ZZ59264
Z
T
  • Résolu(e)
Saisie Userform pour base de données
2
Réponses
24
Affichages
1 K
TAL
T
C
  • Question
Microsoft 365 formules ne pas afficher résultat et calcul
Réponses
0
Affichages
202
Chapichapo
C
chaelie2015
  • Question
XL 2013 Modifier un code de sauvegarde
2
Réponses
16
Affichages
521
chaelie2015
chaelie2015
L
  • Question
XL 2021 filtres automatiques
Réponses
4
Affichages
300
leo13
L
Chubby
  • Question
XL 2016 Comparaison de deux listes avec deux critères
Réponses
4
Affichages
210
Chubby
Chubby

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 30 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote