simba_2015
Messages postés10Date d'inscriptionmardi 4 août 2015StatutMembreDernière intervention18 août 2015
-
Modifié par simba_2015 le 11/08/2015 à 14:30
eriiic
Messages postés24603Date d'inscriptionmardi 11 septembre 2007StatutContributeurDernière intervention15 décembre 2024
-
18 août 2015 à 11:56
Bonjour,
voila, j'ai crée un fichier excel avec tout les codes ci dessous mais lorsque je les exécutes, la macro est longue à ce réaliser(bug).
Le fichier en question, à été créé pour le suivi d'un contrat en Angleterre.
Il passera bientôt en mode test.
Pouvez vous m'aidez à diminuer le temps de réalisation de mes macros ? je sais que l'on peut faire un B1 = C2 à la place d'un copie, paste mais avant de me lancer à modifier tout mon code, je voudrais savoir si sa en vaut la peine ?
De plus j'ai un autre petit soucie pas bien grave mais bon, la ligne 9 de a feuille 1 est masqué et lors de la première utilisation de ma macro pour complété cette feuilles, la ligne 9 ce remplie mais il ne détecte pas quel est rempli et ne passe jamais a la suivante (sauf si j'affiche cette ligne).
Sub complete_job() 'déclaration des variables : Dim Trouve As Range, PlageDeRecherche As Range Dim Valeur_Cherchee As String, AdresseTrouvee As String
Sheets("ALL").Select Columns(22) = Columns(21).Value 'affectation de valeurs aux variables : 'on cherche le mot "YES " Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(22) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
'MsgBox AdresseTrouvee
Sheets("Complete job").Select Range("C7").Select Selection.Copy Sheets("ALL").Select Range("R" & AdresseTrouvee).Select ActiveSheet.Paste Sheets("Complete job").Select Range("C10").Select Selection.Copy Sheets("ALL").Select Range("S" & AdresseTrouvee).Select ActiveSheet.Paste Sheets("Complete job").Select Range("C11").Select Selection.Copy Sheets("ALL").Select Range("O" & AdresseTrouvee).Select ActiveSheet.Paste End If Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("1").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("5").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("6").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("7").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("8").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("9").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("10").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("11").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("13").Select Columns(19) = Columns(18).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(19) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
Sheets("12").Select Columns(24) = Columns(23).Value Valeur_Cherchee = "YES " 'dans la première colonne de la feuille active Set PlageDeRecherche = ActiveSheet.Columns(24) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole) Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole) 'traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvée AdresseTrouvee = 0 Else AdresseTrouvee = Trouve.Row
Sheets("Complete job").Select Application.CutCopyMode = False 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing
End Sub
3/ code de récupération des données sur un fichier word
Option Explicit
Sub récup_word_fault_2()
Dim wdapp As Word.Application Dim wdoc As Word.Document Dim objtable As Word.Table Dim nomfich As String Dim nomdufichier As String nomdufichier = "C:\Users\levasseur tony\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\PNPL3JQX\" nomfich = nomdufichier & Cells(4, 6) & ".doc"
Set wdapp = CreateObject("Word.Application") 'creation session Word wdapp.Visible = True On Error Resume Next
wdapp.Documents.Open Filename:=nomfich Set wdoc = wdapp.activeDocument Set objtable = wdoc.tables(1)
Un grand merci a tout ceux qui aurons le courage de regarder ma publication jusqu'ici et encore un plus grand merci à tout ceux qui m'aiderons dans ma démarche.
michel_m
Messages postés16603Date d'inscriptionlundi 12 septembre 2005StatutContributeurDernière intervention16 décembre 20233 310 Modifié par michel_m le 11/08/2015 à 16:16
Bonjour,
je sais que l'on peut faire un B1 = C2 à la place d'un copie, paste mais avant de me lancer à modifier tout mon code, je voudrais savoir si sa en vaut la peine ?
pas qu'un peu!
règle de base en VBA: éviter les sélect-sélection et les copy paste particulièrement chronophages
commence donc par modifier ca après on verra
d'autre part en début de macro
application.screenupdating=false pour le confort des yeux et la rapidité
simba_2015
Messages postés10Date d'inscriptionmardi 4 août 2015StatutMembreDernière intervention18 août 2015 11 août 2015 à 17:48
Tu sais j'apprend au fur et à mesure, j'avance doucement mais surement...
Je suis déjà très fière de moi d'être arrivé à mes fins! Désolé d'être novice.
michel_m
Messages postés16603Date d'inscriptionlundi 12 septembre 2005StatutContributeurDernière intervention16 décembre 20233 310 11 août 2015 à 18:43
On a tous débuté: donc, ne sois pas désolée...
je regarderai demain à la fraiche
en attendant pour encadrer tes cellules
F.Range("O" & DLig + 1).borders.weight=xlthin
michel_m
Messages postés16603Date d'inscriptionlundi 12 septembre 2005StatutContributeurDernière intervention16 décembre 20233 310 12 août 2015 à 10:29
Bonjour,
Ca avance mais beaucoup d'autres trucs à faire...
donc, sois patiente
michel_m
Messages postés16603Date d'inscriptionlundi 12 septembre 2005StatutContributeurDernière intervention16 décembre 20233 310 12 août 2015 à 13:33
beaucoup d'autres trucs à faire...
hélas, je reprendrai + tard
simba_2015
Messages postés10Date d'inscriptionmardi 4 août 2015StatutMembreDernière intervention18 août 2015 18 août 2015 à 08:55
patient mais merci
mon fichier pourrais t'il être amélioré en utilisant Access plutôt que excel ?
michel_m
Messages postés16603Date d'inscriptionlundi 12 septembre 2005StatutContributeurDernière intervention16 décembre 20233 310
>
simba_2015
Messages postés10Date d'inscriptionmardi 4 août 2015StatutMembreDernière intervention18 août 2015 18 août 2015 à 09:13
bonjour,
mon fichier pourrais t'il être amélioré en utilisant Access plutôt que excel ?
Bof !
il faudrait que tu me ré adresse ton classeur. j'avais une proposition mais je n'ai pas conserver le fichier. j'avais travaillé sur "copie_IMAC"
simba_2015
Messages postés10Date d'inscriptionmardi 4 août 2015StatutMembreDernière intervention18 août 2015 18 août 2015 à 10:02
Bonjour,
mon fichier et toujours disponible dans mon post précédent. il est en test depuis ce matin et c'est surtout l'enregistrement du fichier et la validation du completed job qui est très lente.
je ne peut pas le poster de nouveau car il fait plus de 30MO.
Vous n’avez pas trouvé la réponse que vous recherchez ?
michel_m
Messages postés16603Date d'inscriptionlundi 12 septembre 2005StatutContributeurDernière intervention16 décembre 20233 310 18 août 2015 à 11:35
Gros problème avec tes 2 envois de classeurs car après des écritures dans VBA enregistrées et fermeture du classeur, à la ré-ouverture et demande d'aller dans l'éditeur vba , j'ai un massage fatal: "erreur de chargement de la DLL" et je dois aller dans le gestionnaire des tâches pour sortir, le classeur est inutilisable
j'ai vérifié si ca ne venait pas de moi en allant sur des fichiers avec macros et je n'ai pas ce problème ni de virus après une analyse approfondie...
eriiic
Messages postés24603Date d'inscriptionmardi 11 septembre 2007StatutContributeurDernière intervention15 décembre 20247 249 Modifié par eriiic le 18/08/2015 à 12:06
Bonjour,
Gros problème avec tes 2 envois de classeurs... Je confirme.
Même pas besoin d'éditer le vba. Après un simple 'Enregistrer sous...' en changeant le nom tout de suite après ouverture suffit à rendre le code inaccessible à l'ouverture suivante.
eric
edit: en fait le classeur se ferme bien mais le projet n'est pas déchargé. Si ça t'inspire michel
Discussions sur les outils et logiciels de bureautique. Trouvez des solutions à vos problèmes, apprenez des astuces pour maximiser votre productivité et connectez-vous avec une communauté dédiée à l'efficacité au travail.