Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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
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

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

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
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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

L
  • Question
Problème de formule
Réponses
9
Affichages
395
LILI67
L
R
  • Résolu(e)
Microsoft 365 Code VBA "Tableau gestionnaire"
2
Réponses
22
Affichages
822
Rosario.
R
N
  • Question
Microsoft 365 excel sommes si ens en ligne ou somme prod.
Réponses
4
Affichages
379
nicolulu
N
K
  • Résolu(e)
XL 2019 Aide pour macro vba
2
Réponses
20
Affichages
689
Kev1407
K
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
R
  • Question
Microsoft 365 condition pour supprimer une valeur dans une cellule
Réponses
4
Affichages
259
ricouvbx
R
T
  • Résolu(e)
Autres Classement colonnes en VBA
2
Réponses
27
Affichages
2 K
Twisty
T
R
  • Question
Microsoft 365 VBA Excel PowerPoint
Réponses
5
Affichages
242
Rem6610
R
N
  • Question
XL 2016 Récupération de lignes dans un autre fichier excel
Réponses
4
Affichages
316
ninieg
N
B
  • Résolu(e)
Microsoft 365 Problème dans formule VBA
Réponses
7
Affichages
181
BOILEAU
B
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…