Bug que je ne parviens pas à solutionner
Bonjour à tous, depuis que j'ai optimisé mon code en supprimant de nombreux "Activate" je rencontre deux problèmes que je ne parviens pas à cibler
J'utilise une macro dont voici le code :
Public Jaune As Integer
Sub copierplanaction()
Dim i, j, k, lig, couleur As Integer
Dim cellule, cellule1, action, cola, colb, colc, cold, cole, colf, colg, colh, coli, datelimite, user, File, nomfeuille As String
Dim test As Boolean
'initialisation point jaune et test
Jaune = 1
Worksheets("Skid").Range("G97").Value = Jaune
Worksheets("En_cours").Range("N20").Value = Jaune
test = False
'lancement du formulaire de récupération du nombre de lignes
DerniereLigneCopiePlanAction.Show 0
Do While DerniereLigneCopiePlanAction.Visible = True
DoEvents
Loop
i = Worksheets("Skid").Range("G90").Value
'Worksheets("Skid").Activate
'i = Range("G90").Value
'Worksheets("En_cours").Activate
'récupération du service de l'appereil en cours de validation
'partie enregistrement / Définition du service
Do
SecteurPlanAction.Show
Do While DerniereLigneCopiePlanAction.Visible = True
DoEvents
Loop
k = Worksheets("Skid").Range("G91").Value
'Worksheets("Skid").Activate
'k = Range("G91").Value
'k = Application.InputBox("Veuillez indiquer le secteur du plan d'action :" & vbCrLf & "1 pour UP1," & vbCrLf & "2 pour UP2," & vbCrLf & "3 pour Les Utilitées," & vbCrLf & "4 pour Fab et pesée" & vbCrLf & "5 pour les RH" & vbCrLf & "6 pour les Flux" & vbCrLf & "7 pour la Qualité" & vbCrLf & "8 pour ETNEHS", "Secteur concerné?", , , , , , 1)
If k < 1 Or k > 8 Then
MsgBox "vous avez saisie un nombre inexistant"
End If
Loop Until k = 1 Or k = 2 Or k = 3 Or k = 4 Or k = 5 Or k = 6 Or k = 7 Or k = 8
'ouverture du fichier de plan d'action
'Attention je part du principe que les deux fichiers sont dans le même répertoire
Application.ScreenUpdating = False
'récupération du nom utilisateur
user = Interaction.Environ("UserName")
'constitution du nom du fichier
File = "C:\Users\" & user & "\L'Oréal\-FR- SPRCOS - PowerBI - ETNEHS\ETNEHS\EHS\Validations\Validations.xlsx"
'ouverture avec maj automatique des liens
Workbooks.Open File, 0 'UpdateLinks = xlUpdateLinksNever
'réactivation de l'écran
'Application.ScreenUpdating = True
'activaion du bon onglet
If k = 1 Then
Worksheets("UP1").Activate
nomfeuille = "UP1"
ElseIf k = 2 Then
Worksheets("UP2").Activate
nomfeuille = "UP2"
ElseIf k = 3 Then
Worksheets("Utilités").Activate
nomfeuille = "Utilités"
ElseIf k = 4 Then
Worksheets("FAB et Pesée").Activate
nomfeuille = "FAB et Pesée"
ElseIf k = 5 Then
Worksheets("RH").Activate
nomfeuille = "RH"
ElseIf k = 6 Then
Worksheets("Flux").Activate
nomfeuille = "Flux"
ElseIf k = 7 Then
Worksheets("Qualité").Activate
nomfeuille = "Qualité"
ElseIf k = 8 Then
Worksheets("ETNEHS").Activate
nomfeuille = "ETNEHS"
End If
'cherche la dernière ligne vide
lig = 1 'première ligne à vérifier
Do While Not IsEmpty(Range("A" & lig))
lig = lig + 1
Loop
'réactivation du fichier actuel
ThisWorkbook.Activate
'réactivation de l'écran
Application.ScreenUpdating = True
'Préparation des colonnes fixes
cola = "Validation EHS"
colb = Now
'Récupération des nom valideur et responsable d'action
UsrValideurResponsable.Show
Do While UsrValideurResponsable.Visible = True
DoEvents
Loop
'désactivation de l'écran
'Application.ScreenUpdating = False
'puis récupération sur les case de skid
colc = Worksheets("Skid").Range("G92").Value
coli = Worksheets("Skid").Range("G93").Value
'Worksheets("Skid").Activate
'colc = Range("G92").Value
'coli = Range("G93").Value
'Worksheets("En_cours").Activate
colf = Range("A1").Value
'boucle d'ecriture de chaque ligne
For j = 13 To i
ThisWorkbook.Worksheets("Skid").Range("G97").Value = Jaune
ThisWorkbook.Worksheets("En_Cours").Range("N20").Value = Jaune
'test si ligne d'entete
If Range("B" & j).Value = "Problème décelé" Then
'entete, je saute 2 lignes"
j = j + 2
Else
'je teste si c'est une action soldée
If Range("J" & j).Value = "X" Or Range("J" & j).Value = "x" Then test = True
If test = False Then
'Balayage de chaque ligne et récupération de la valeur
cellule = "B" + CStr(j)
cellule1 = "C" + CStr(j)
action = Range(cellule).Value
'copie dans le plan d'action
'en premier je test si la case action est pleine ou non
If action <> "" Then
'la cellule n'est pas vide je copie
'Ecriture du N° de point jaune
'Worksheets("Skid").Range("G97").Value = Jaune
'Worksheets("Skid").Activate
'Range("G97").Value = jaune
'Worksheets("En_cours").Activate
'ecriture dans fichier de validation
With Workbooks("validations.xlsx").Worksheets(nomfeuille)
'ecriture des lignes fixes
.Range("A" & lig).Value = cola
.Range("B" & lig).Value = colb
.Range("C" & lig).Value = colc
.Range("F" & lig).Value = colf
.Range("I" & lig).Value = coli
End With
'Workbooks("validations.xlsx").Activate
'ecriture des lignes fixes
'Range("A" & lig).Value = cola
'Range("B" & lig).Value = colb
'Range("C" & lig).Value = colc
'Range("F" & lig).Value = colf
'Range("I" & lig).Value = coli
'activation du fichier actuel
'ThisWorkbook.Activate
'récupération des lignes changeantes
colg = Range("A" & j).Value + " : " + Range("B" & j).Value
'recupération de la couleur de texte
couleur = Range("B" & j).Font.ColorIndex
colh = Range("E" & j).Value
'réactivation du fichier de plan d'action
'Workbooks("validations.xlsx").Activate
'écritures des colonnes changeantes
With Workbooks("validations.xlsx").Worksheets(nomfeuille)
.Range("H" & lig).Value = colh
.Range("G" & lig).Value = colg
'report de la couleur de texte
.Range("G" & lig).Font.ColorIndex = couleur
End With
'Range("H" & lig).Value = colh
'Range("G" & lig).Value = colg
'report de la couleur de texte
'Range("G" & lig).Font.ColorIndex = couleur
'activation du fichier actuel
'ThisWorkbook.Activate
'Ajout d'un point jaune si nécessaire
If Range("H" & j).Value = "J" Or Range("H" & j).Value = "j" Then
'activation du fichier de validation
'Workbooks("validations.xlsx").Activate
'critures des cases spécifiques au points jaunes
With Workbooks("validations.xlsx").Worksheets(nomfeuille)
.Range("D" & lig).Value = "Point jaune"
.Range("D" & lig).Interior.ColorIndex = 6
End With
'activation du fichier actuel
'ThisWorkbook.Activate
DateValiditePointJaune.Show 0
Do While DateValiditePointJaune.Visible = True
DoEvents
Loop
'récupération de la date limite du point jaune
datelimite = Worksheets("Skid").Range("G98").Value
MsgBox datelimite
Jaune = Jaune + 1
'Worksheets("Skid").Activate
'datelimite = Range("G98").Value
'activation du fichier de validation
'Workbooks("validations.xlsx").Activate
With Workbooks("validations.xlsx").Worksheets(nomfeuille)
.Range("E" & lig).Value = datelimite
End With
End If
'Ajout d'un point rouge si nécessaire
If Range("H" & j).Value = "R" Or Range("H" & j).Value = "r" Then
'activation du fichier de validation
'Workbooks("validations.xlsx").Activate
'ecritures des cases spécifiques au points jaunes
With Workbooks("validations.xlsx").Worksheets(nomfeuille)
.Range("D" & lig).Value = "Point rouge"
.Range("D" & lig).Interior.ColorIndex = 3
End With
'activation du fichier actuel
'ThisWorkbook.Activate
End If
'passage à la ligne suivante
lig = lig + 1
'réactivation du fichier actuel
'ThisWorkbook.Activate
'Worksheets("En_cours").Activate
End If
End If
'réinitialisation du test
test = False
End If
Next j
'fermeture du plan d'action
Workbooks("validations.xlsx").Close SaveChanges:=True
'réactivation de l'écran
Application.ScreenUpdating = True
End SubLa variable "Jaune" permets de comptabiliser un paramètre spécifique et de ce côté tout se passe bien mais cette variable n'est pas correctement utilisée.
Cette variable est normalement écrite dans "
Worksheets("Skid").Range("G97").Valuepour la suivre, j'ai désactiver le figeage de l'écran la ou il y a des espaces et je l'écrit également dans la page en cours
ThisWorkbook.Worksheets("En_Cours").Range("N20").ValueLe suivi visuel me montre bien que celle-ci évolue correctement pourtant à l'ouverture de ma Userform DateValiditéPointJaune la valeur n'est pas reprise correctement, voici le code d'initialisation de la Userform :
Private Sub UserForm_Initialize()
Dim phrase As String
'Initialisation de la phrase de question
'Worksheets("Skid").Activate
MsgBox Jaune
phrase = "Veuillez indiquer la limite de validité du point jaune N°" & Jaune 'ThisWorkbook.Worksheets("Skid").Range("G97").Value
Label1.Caption = phrase
End Submais "phrase" ne se termine pas par le bon N° et je ne parviens pas à trouver pourquoi
J'ai également un autre soucis, je saisi une date dans une zone de texte au niveau de cette userform et quand je l'enregistre elle est convertie d'un en un format US ex 03/09/2025 deviens 09/03/2025, comment puis imposer de conserver le format de saisie d'origine (03/09/2025)
Désolé pour ce long roman, je bug sur ces deux problème depuis des heures et merci d'avance pour toute aide
Bonne journée à tous
Bonjour,
Pour la variable Jaune, elle prend la valeur avant d'etre incrémentée. Je ne sais pas si c'est de ça qu'il s'agit.
Pour le format de date, personnellement je préfère redécouper le texte et créer une vraie date avec la fonction DateSerial function (Visual Basic for Applications) | Microsoft Learn.
Tu coupes sur les "/" avec Left/Mid/Right par exemple, et tu les mets dans DateSerial.
left("11/1/2025",instr(1,"11/1/2025","/")-1) te renvoie 11
x="11/1/2025":mid(x,instr(1,x,"/")+1,instrrev(x,"/")-instr(1,x,"/")-1) te renvoie 1
right("11/1/2025",instrrev("11/1/2025","/")-1) te renvoie 2025
merci pour le retour sur la date qui permettra de solutionner le problème
Pour le reste, je n'en comprends pas la raison mais en mettant le code dans la procédure activate au lieu de nintialize de la userform, cela fonctionne
bonne journée à tous
Ah ouiii… Désolé je vous explique :
Dans votre code, l'UF n'est initialisé qu'une seule fois : lors du premier "Show". Ensuite le code va récupérer le "vieil" UF et le réafficher/réactiver. C'est pourquoi être dans Activate fait la mise à jour, mais Initalize non.
Si vous voulez créer un nouvel userform il faut écrire
With New DateValiditePointJaune
.Show
End With
Et là, à la fin du with l'UF est détruit/ou en tout cas n'est plus accessible, et un nouveau sera créé la prochaine fois.
Mais bon, si ça fonctionne avec Activate, vous pouvez le laisser dedans.
Bonne journée ègalement.
OK, merci de cette information, j'en apprends tous les jours sur les subtilités du VBA :)
bonne journée
Bonsoir,
saboh12617 bonsoir,
pour la date, si vous découpez, vous pourriez Spliter sur les "/" afin d'obtenir trois valeur correspondant aux trois données du Tablo ainsi récupéré
TextBox1 = "12/08/2025"
Tablo= Split(TextBox1,"/")
' donne Tablo(0) = 12, Tablo(1) = 08 et Tablo(2) = 2025VBA est anglais et travail avec des dates anglaise me semble t il ? Pourquoi vouloir remettre le tout à l'endroit ? Pour l'afficher sur la feuille Excel ? Alors c'est cette dernière qui doit s'en occuper : Range("A1") = CDate(TextBox1), et le format de la cellule est en format date jj/mm/aaaa européen, non ?
@ bientôt
LouReeD
Bonsoir,
quel est le but de ceci :
'cherche la dernière ligne vide
lig = 1 'première ligne à vérifier
Do While Not IsEmpty(Range("A" & lig))
lig = lig + 1
Loop@ bientôt
LouReeD
Bonjour LouReeD, cette partie sert à déterminer la fin des enregistrements pour écrire les nouvelles lignes à la suite (Ligne Lig)
Pour les dates il semble en effet que Excell s'acharne à me les convertir en format Anglais, en effet il est possible de le gérer dans le fichier de destination lui même mais comme je ne suis pas le seul à travailler dessus et que nous ne l'utilisons qu'en france, j'ai préféré vérouiller "En dur" par le code suivant :
datelimite = Format(Worksheets("Skid").Range("G98").Value, "dd/mm/yyyy")
Bonne journée
Bonsoir,
saboh12617 bonsoir,pour la date, si vous découpez, vous pourriez Spliter sur les "/" afin d'obtenir trois valeur correspondant aux trois données du Tablo ainsi récupéré
TextBox1 = "12/08/2025" Tablo= Split(TextBox1,"/") ' donne Tablo(0) = 12, Tablo(1) = 08 et Tablo(2) = 2025VBA est anglais et travail avec des dates anglaise me semble t il ? Pourquoi vouloir remettre le tout à l'endroit ? Pour l'afficher sur la feuille Excel ? Alors c'est cette dernière qui doit s'en occuper : Range("A1") = CDate(TextBox1), et le format de la cellule est en format date jj/mm/aaaa européen, non ?
@ bientôt
LouReeD
Bonjour à tous,
Des fois on en oublie les bases… Merci @LooReed pour ce rappel plus que bienvenue 😂
Perso vu que je travaille sur des combinaisons Excel/Windows en Français/Anglais/Italien je préfère entrer mes dates avec la fonction DateSerial, mais bon oui en fonction du contexte tout est adaptable.
Bonne journée.