VBA Excel:comment formuler le end(xldown) d'1 union de colonnes?
Résolu
Dianex87
Messages postés
79
Statut
Membre
-
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
Bonjour à tous,
Je rencontre le problème suivant: j'ai un fichier de 250 lignes environ avec une vingtaine de colonnes. les lignes listent des problèmes rencontrés sur un sujet, et les colonnes les paramètres (date de création, satut ouvert/clos, nom du client...).
Je souhaite filtrer sur la colonne "QTR" par exemple les cellules non-vides uniquement (en general remplies par un X ou un P), et que cette colonne filtrée, et d'autres colonnes non-contigües soient copiées-collées sur une autre feuille de mon fichier Excel à un emplacement bien defini.
J'ai simplifié au possible mon document que j'ai joint ici, avec le code correspondant :
http://www.cjoint.com/c/GEEmWnotXOY
Avec le "record macro" je me suis rendue compte que le pb de taille différente entre la plage à copier et la destination de la copie n'existe plus si je limite ma selection de colonnes jusqu'à la dernière ligne de la colonne QTR, CAD de A2 à A14 dans cet exemple. Au lieu de laisser toutes les colonnes qui vont jusque 1 000 000 de lignes et plus et font peut-être saturer la mémoire.
Mon pb est que je n'arrive pas à formuler l' union des colonnes jusqu'à la dernière ligne de QTR avec la syntaxe type Range(ActiveCell, ActiveCell.End(xlDown)).Select
J'ai laissé en commentaires la fin de la macro afin qu'on voie bien que seule la cellule A2 (QTR) est sélectionnée (et donc collée sur la feuille 2, si j'ote ces ' à la fin).
Si ça peut aider à une vision plus globale, le but final est de générer automatiquement des tableaux filtrés selon le client auquel on s'intéresse (QTR ici); que ces tableaux soient copiés-collés sur des plages précises sur une autre feuille pré-remplie du fichier Excel; et cela doit se répercuter sur des fichiers Powerpoint (un PPT/client). J'aurais certainement d'autres blocages pour lesquels je reviendrais. ;-)
Mais déjà, mille mercis par avance !
Dianex
Je rencontre le problème suivant: j'ai un fichier de 250 lignes environ avec une vingtaine de colonnes. les lignes listent des problèmes rencontrés sur un sujet, et les colonnes les paramètres (date de création, satut ouvert/clos, nom du client...).
Je souhaite filtrer sur la colonne "QTR" par exemple les cellules non-vides uniquement (en general remplies par un X ou un P), et que cette colonne filtrée, et d'autres colonnes non-contigües soient copiées-collées sur une autre feuille de mon fichier Excel à un emplacement bien defini.
J'ai simplifié au possible mon document que j'ai joint ici, avec le code correspondant :
http://www.cjoint.com/c/GEEmWnotXOY
Sub Col_Select()
Dim Cel As Range
Dim MyUnion As Range
Dim Blastrow As Long
Blastrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
Worksheets("Sheet1").Activate
'Sélection de la colonne en fonction de son en-tête
Set Cel = Cells.Find(what:="QTR")
' If Not Cel Is Nothing Then
Cells(2, Cel.column).Resize(Cells(Rows.Count, Cel.column).End(xlUp).Row).Select
' Else
' MsgBox "Pas trouvé le nom "
'Exit Sub
' End If
ActiveCell.AutoFilter Field:=1, Criteria1:="P", Operator:=xlOr, Criteria2:="X"
'ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select --> 'fontionne bien mais mais copie-colle toutes les colonnes or moi j'en veux certaines!
'Avant c'était: Range("A2").CurrentRegion.Copy But the 1st line wasn't removed
'With Sheets("sheet1")
' Union(.Columns(1), .Columns(3), .Columns(5)) As Range
'End With --> n'a pas fonctionné...
Set MyUnion = (Union(Columns(1), Columns(3), Columns(5)).End(xlDown))
MyUnion.Select
Selection.Copy
'Worksheets("Sheet2").Activate
'Range("B5").Select
'Activesheet.Paste
'Sheets("Sheet2").Range("B5").PasteSpecial x
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkripBlanks:=False, Transpose:=False
'Application.CutCopyMode = False x
'Worksheets("Sheet1").AutoFilterMode = False x
End Sub
Avec le "record macro" je me suis rendue compte que le pb de taille différente entre la plage à copier et la destination de la copie n'existe plus si je limite ma selection de colonnes jusqu'à la dernière ligne de la colonne QTR, CAD de A2 à A14 dans cet exemple. Au lieu de laisser toutes les colonnes qui vont jusque 1 000 000 de lignes et plus et font peut-être saturer la mémoire.
Mon pb est que je n'arrive pas à formuler l' union des colonnes jusqu'à la dernière ligne de QTR avec la syntaxe type Range(ActiveCell, ActiveCell.End(xlDown)).Select
J'ai laissé en commentaires la fin de la macro afin qu'on voie bien que seule la cellule A2 (QTR) est sélectionnée (et donc collée sur la feuille 2, si j'ote ces ' à la fin).
Si ça peut aider à une vision plus globale, le but final est de générer automatiquement des tableaux filtrés selon le client auquel on s'intéresse (QTR ici); que ces tableaux soient copiés-collés sur des plages précises sur une autre feuille pré-remplie du fichier Excel; et cela doit se répercuter sur des fichiers Powerpoint (un PPT/client). J'aurais certainement d'autres blocages pour lesquels je reviendrais. ;-)
Mais déjà, mille mercis par avance !
Dianex
8 réponses
Résumé de la discussion
Le problème porte sur le filtrage de la colonne QTR pour ne retenir que les cellules non vides (P ou X) et sur la copie de colonnes vers une autre feuille avec une plage définie. Des solutions suggérées incluent l'utilisation d'AutoFilter sur QTR et la limitation de la plage de A2 à la dernière ligne, puis l'Union de colonnes ciblées (par exemple A, C, E) avant le collage sur Sheet2. En pratique, limiter la plage à la dernière ligne de QTR évite des traitements lourds et des erreurs, et certains échanges évoquent l'usage de références Microsoft Office pour l'export vers PowerPoint.
-
Bonsoir,
ci-dessous proposition de solution sans filtrage
Sub copie()
Dim qtr As Range, ligne_à_copier As Range, lignes_à_copier As Range, décalages As Object
Dim col_i As Integer, p As Integer, l As Integer, c As Integer, tb()
'// stockage lignes à copier
For Each qtr In Sheet1.Columns("A").SpecialCells(xlCellTypeConstants)
Set ligne_à_copier = Union(qtr, qtr.Offset(, 2), qtr.Offset(, 4)) 'colonnes A, C, E
If lignes_à_copier Is Nothing Then Set lignes_à_copier = ligne_à_copier _
Else Set lignes_à_copier = Union(lignes_à_copier, ligne_à_copier)
Next qtr
'// copie sur Sheet2
Set décalages = CreateObject("Scripting.Dictionary") 'création collection type dictionnaire
col_i = 0 'initialisation décalage colonne
For p = 1 To lignes_à_copier.Areas.Count
c1 = lignes_à_copier.Areas(p).Column 'première colonne de la plage en cours
If Not décalages.exists(c1) Then
If p > 1 Then col_i = col_i + lignes_à_copier.Areas(p - 1).Columns.Count 'décalage colonne
décalages.Add Key:=c1, Item:=Array(0, col_i)
End If
tb = décalages(c1): l = tb(0): c = tb(1) 'récupération décalage ligne et colonne
lignes_à_copier.Areas(p).Copy Sheet2.Range("A1").Offset(l, c)
tb(0) = tb(0) + lignes_à_copier.Areas(p).Rows.Count 'incrémentation décalage ligne
décalages(c1) = tb 'mise à jour décalage ligne
Next p
End Sub-
Bonjour Thev,
Et merci de ta réponse. Et effectivement cela fonctionne, si ce n'est que les ligne d'en-têtes (QTR, THA et CPA) sont aussi copiées, ce que je ne souhaite pas.
J'ai donc ajusté comme suit:
'Set ligne_à_copier = Union(qtr.Offset(1, 0), qtr.Offset(1, 2), qtr.Offset(1, 4)) 'colonnes A, C, E et 2ème ligne
Les lignes d'en-tête disparaissent bien mais quelques données "P" de la colonne QTR disparaissent également, et je ne vois pas d'explication...
A côté de ça, je dois t'avouer qu'en dépit des commentaires je n'ai pas vraiment compris... Surtout la partie "copie sur sheet2". 2 Questions:
1- dire "for each qtr"... Ce sera toujours QTR à cet emplacement, donc la boucle va tourner pour faire la meme chose, non? Il est vrai que j'ai bcp simplifié le fichier joint dans le msg initial mais dans le "vrai fichier" ce sera une combo box qui proposera de choisir un client (QTR par exemple) et divers filtres seront lancés ensuite, et les résultats copiés sur une autre sheet à des espaces prepares à cet escient, et cela sera copié sur des powerpoint (1ppt/client). Mais bon une chose à la fois! :)
2- autrement tu ne vois pas de solution à ma question Mon pb est que je n'arrive pas à formuler l'union des colonnes jusqu'à la dernière ligne de QTR avec la syntaxe type Range(ActiveCell, ActiveCell.End(xlDown)).Select ? Est ce que l'union de column peut être combiné avec la syntaxe .End(xlDown)), ou pas ?
En continuant de chercher j'ai pensé à ceci mais VBA le laisse marqué en rouge; peut être que tu verras où est l'erreur?
Application.MyUnion("A2:A" & lastrowA & ", C2:C" & lastrowC & ", E2:E" & lastrowE &").Selection.copy
Merci bcp de ton retour,
Les autres VBA experts, please don't be shy ! :)
Dianex- Bonjour a vous deux
l'union de column peut être combiné avec la syntaxe .End(xlDown)), ou pas ?
Pas, sauf si quelqu'un a une idee lumineuse
Il est vrai que j'ai bcp simplifié le fichier
Fallait pas, car vu que vous allez faire choisir la colonne a filtrer (si j'ai bien compris), ca pose quelques soucis
Par contre le code de thev est peut-etre seulement a modifier en fonction du choix colonne
Et question:
Vous copiez colonnes A,C,E peut importe le choix colonne filtree ? - Bonjour à toi, f894009!
Merci de votre réponse.
Pas, sauf si quelqu'un a une idee lumineuse
Oh non, quell dommage :(
Pour répondre à votre question, les colonnes à copier sont toujours les mêmes et celles à filtrer aussi. Mais celles qu'on filre ne sont pas celles qu'on copie! Dans le fichier simplifié c'était A, C et E mais dans le "vrai fichier", il y en a 6 ou 2 selon les cas; et les index de colonnes different de 1, 3 et 5.
Fallait pas, car vu que vous allez faire choisir la colonne a filtrer (si j'ai bien compris), ca pose quelques soucis
Ceci dit vous avez raison, j'étais tellement obsédée par cette problématique precise de end(xldown) et d'union de colonnes que j'ai tout centré dessus.
Je travaille à anonymiser mon fichier pour que ma problématique d'ensemble soit mieux compréhensible, et je reviens la poster ici.
Merci,
@+ tard
Dianex
-
-
Bonjour,
Pour supprimer la ligne d'entête, il suffit d'ajouter cette condition (la ligne de la variable objet "qtr" doit être supérieure à la première ligne de la plage de la colonne A comportant des constantes)
'// stockage lignes à copier
For Each qtr In Sheet1.Columns("A").SpecialCells(xlCellTypeConstants)
If qtr.Row > Sheet1.Columns("A").SpecialCells(xlCellTypeConstants).Row Then
Set ligne_à_copier = Union(qtr, qtr.Offset(, 2), qtr.Offset(, 4)) 'colonnes A, C, E
If lignes_à_copier Is Nothing Then Set lignes_à_copier = ligne_à_copier _
Else Set lignes_à_copier = Union(lignes_à_copier, ligne_à_copier)
End If
Next qtr
Le code relatif à la copie est compliqué du fait qu'il s'agit d'union de plages discontinues qui ne peuvent être gérées que via la propriété "Areas".
Je peux te donner un code beaucoup plus simple mais j'ai d'abord voulu suivre ton idée de départ avec l'union de différentes plages. Et de toute façon, il vaut mieux attendre ta problématique d'ensemble pour une autre proposition.
-
Bonjour à tous les 2 (et les autres :-) ),
J'ai été absorbée par d'autres projets et ai manqué de temps, mais je reviens vous montrer ma problématique d'ensemble anonymisée! Elle est dispo ici: http://www.cjoint.com/c/GFhjUhjxVIV
Le password du bouton Maintenance de la page "Home" est "maintenance" ; autrement les feuilles sont protégées.
Je precise aussi que de 1ères macros avaient déjà été effectuées sur ce projet, mais elles n'impactent pas ma recherche actuelle.
La pblématique: sur la feuille AL Extract l'utilisateur choisit un client en cliquant sur "Select an airline". En sélectionnant par exemple QTR ds la Combo Box je voudrais que ça lance la macro complète ci-dessous mais je n'ai pas réussi à le formaliser comme ceci par exemple, et c'est mon prinicipal souci ici:
'Set Cel = Cells.Find(what:="ComboBoxAL.Value")
La macro va faire les filtres demandés sur la page "External TFU-TDO" et va afficher les résultats pour chaque système dans une cellule définie de la feuille AL Extract.
Le code complet principal à fignoler avec votre aide est le suivant:
Sub Col_Select_ENGIN()
'la macro fonctionne. il faudrait ajuster la mise en forme des cellules copiées (pas de remplissage, et cellules dans la même mise en forme que la zone de destination. Toute suggestion est bienvenue :) )
Dim Cel As Range
Dim MyUnion As Range
Dim lastrowL As Long
Dim lastrowM As Long
Dim lastrowN As Long
Dim lastrowAF As Long
Dim lastrowAG As Long
Dim lastrowAI As Long
lastrowL = ActiveSheet.Cells(Rows.Count, 12).End(xlUp).Row
lastrowM = ActiveSheet.Cells(Rows.Count, 13).End(xlUp).Row
lastrowN = ActiveSheet.Cells(Rows.Count, 14).End(xlUp).Row
lastrowAF = ActiveSheet.Cells(Rows.Count, 32).End(xlUp).Row
lastrowAG = ActiveSheet.Cells(Rows.Count, 33).End(xlUp).Row
lastrowAI = ActiveSheet.Cells(Rows.Count, 35).End(xlUp).Row
Worksheets("External TFU-TDO").Activate
'Sélection de la colonne en fonction de son en-tête type Set Cel = Cells.Find(what:="QTR")
'Set Cel = Cells.Find(what:=ComboBoxAL.Value) --> Affiche Run time error: Object required
'Set Cel = Cells.Find(what:="ComboBoxAL.Value")--> je voudrais que ça marche de cette façon, selon le choix fait dans la Combo Box
Set Cel = Cells.Find(what:="QTR")
Cells(3, Cel.Column).Resize(Cells(Rows.Count, Cel.Column).End(xlUp).Row).Select
ActiveCell.AutoFilter Field:=17, Criteria1:="P", Operator:=xlOr, Criteria2:="X"
ActiveCell.AutoFilter Field:=16, Criteria1:="External"
ActiveCell.AutoFilter Field:=12, Criteria1:="TFU"
'Pour le système Water & Waste
ActiveCell.AutoFilter Field:=11, Criteria1:="Water & Waste"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("B5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Smoke Detection
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Smoke Detection"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("I5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Seats
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Seats"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("P5").PasteSpecial
Application.CutCopyMode = False
'Pour le système SCS
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="SCS"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("W5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Pax Door
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Pax Door"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("AD5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Oxygen
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Oxygen"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("AK5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Lights + Lights(Emer)
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Lights", Operator:=xlOr, Criteria2:="Lights(Emer)"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("AR5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Lavatories
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Lavatories"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("AY5").PasteSpecial
Application.CutCopyMode = False
'Pour le système IFE
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="IFE"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("BF5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Heating
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Heating"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("BM5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Galley/gains
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Galley/gains"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("BT5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Emergency Systems
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Emergency Systems"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("CA5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Cockpit
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Cockpit"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("CH5").PasteSpecial
Application.CutCopyMode = False
'Pour le système CIDS
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="CIDS"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("CO5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Cargo
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Cargo"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("CV5").PasteSpecial
Application.CutCopyMode = False
'Pour le système Cabin & crew rest
Worksheets("External TFU-TDO").Activate
ActiveCell.AutoFilter Field:=11, Criteria1:="Cargo"
'Union des seules colonnes que je souhaite copier-coller
Range("L3:L" & lastrowL & ", M3:M" & lastrowM & ", N3:N" & lastrowN & ", AF3:AF" & lastrowAF & ", AG3:AG" & lastrowAG & ", AI3:AI" & lastrowAI).Select
Selection.Copy
Sheets("AL Extract").Range("DC5").PasteSpecial
Application.CutCopyMode = False
'Après avoir fait tous les systèmes
With Sheets("External TFU-TDO")
If .AutoFilterMode Or .FilterMode Then .ShowAllData
End With
End Sub
Une fois tous les systèmes faits et mes tableaux bien remplis sur la feuille AL Extract, ces tableaux doivent être copiés sur un document Powerpoint (1/airline), à des endroits spécifiques (numéros de slide etc.) Sachant qu'un copier-coller avec liens ne convient pas car mes tableaux changeront alors selon le choix de airline... Je ne me suis pas encore penchée dessus mais c'est le second volet de ma problématique que je développerai une fois celui-ci résolu.
Merci bcp !
Dianex- Merci de ta réaction rapide,
Seulement le site mon-partage.fr semble bloqué à mon travail et je ne peux pas ouvrir le fichier, désolée... Ce serait vrmt très sympa de le partager via cjoint.com
Sinon, tu as raison pour le error... Je l'ai remarqué en testant mais ai oublié de le notifier.
Et effectivement il est possible que certaines companies ne soient pas affectées sur certains sytèmes, d'où le error !
Dans ces cas là il me semble qu'on peut faire qlq chose avec "On error resume next"? Saurais tu me dire si c'est approprié ici et comment l'utiliser stp ?
Dans l'attente,
Merci bcp! - Re,
Avais oublie pour mon partage
https://www.cjoint.com/c/GFhoADyQYKf
A vous de tester
qlq chose avec "On error resume next"? Saurais tu me dire si c'est approprié ici et comment l'utiliser stp ?
Je regarde.
-
-
Bonjour,
je ne sais pas où tu en es sur ta question initiale ni si j'ai bien compris mais je te propose ça :Dim pl As Range Set pl = Intersect([A2].CurrentRegion, Union([A:B], [D:E])) pl.Copy Sheet2.[A2]
sur la base de ton 1er fichier.
eric
PS : pl.Offset(1).Copy Sheet2.[A2] si tu ne veux pas de la ligne de titre
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.(les Shadoks)
En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci-
Hello Eric,
Je crains que mon apprehension de VBA Excel ne soit pas assez fine pour apprécier ta proposition à sa juste valeur comme f894009, mais merci bcp de ta réponse ! :)
Pour la comprendre je l'ai appliquée sur mon fichier initial et les colonnes copiées sont logiquement A, B, D et E. Or souhaitant les A, C et E j'ai tenté:
Set pl = Intersect([A2].CurrentRegion, Union([A], [C], [E]))
'puis ceci:
Set pl = Intersect([A2].CurrentRegion, Union([A:A], [C:C], [E:E]))
Le 1er ne fonctionne pas, y a un break code. Et le 2nd m affiche bien les colonnes A, C mais la colonne E est répétée 2 fois... Pourquoi ?
Merci de tes éclaircissements histoire que je comprenne mieux la methode "Intersect".
Dianex -
-
-
Et le 2nd m affiche bien les colonnes A, C mais la colonne E est répétée 2 fois... Pourquoi ?
Pas testé car je n'ai plus le fichier d'ouvert mais m'est avis que tu n'as pas effacé le résultat précédent avant et tu en vois le bout non écrasé.
Toujours nettoyer la plage de réception avant, d'autant plus que tu peux avoir moins de lignes et les anciennes resteront aussi. -
Re eriiic,
Toujours nettoyer la plage de réception avant, d'autant plus que tu peux avoir moins de lignes et les anciennes resteront aussi.
Ton code marche au poil et dans le code que j'ai mis a dispo, je fais la raz des anciennes donnees sinon c'est le binz
-
-
Bonjour
eriiic
Magnifique ce code, je l'ai adapte a son contexte et j'ai simplifie la chose
Dianex87:
je ai fais des modif du Sub Col_Select_ENGIN(Choix), il me reste juste la raz des tableaux avant remplissage et le formatage des cellules copiees
Et le traitement d'erreur sur pas de cellules copiees sur filtre
Suite:
code modifie:
Il y a un probleme de la protection de vos feuilles, mais je verifie kake chose
Pour l'encadrement des donnees copiees, il y a une colonne qui n'a pas cet encadrement vu qu'elle ne fait pas partie de la copie, faut ou faut pas d'encadrement?
Sub Col_Select_ENGIN(Choix) 'la macro fonctionne. il faudrait juste ajuster la mise en forme des cellules copiées '(pas de remplissage, et cellules dans la même mise en forme que la zone de destination. Toute idée est bienvenue :) ) Dim Cel As Range Dim ColChoix As Long Dim TCrit Dim LTCrit As Long Dim TCel Dim pl As Range TCrit = Array("Water & Waste", "Smoke Detection", "Seats", "SCS", "Pax Door", "Oxygen", "Lights*", "Lavatories" _ , "IFE", "Heating", "Galley/gains", "Emergency Systems", "Cockpit", "CIDS", "Cargo") LTCrit = UBound(TCrit) TCel = Array("B5", "I5", "P5", "W5", "AD5", "AK5", "AR5", "AY5", "BF5", "BM5", "BT5", "CA5", "CH5", "CO5", "CV5") With Worksheets("AL Extract") .Unprotect .Rows("5:500").Cells.Clear End With Worksheets("External TFU-TDO").Activate 'Sélection de la colonne en fonction de son en-tête type Set Cel = Cells.Find(what:="MAU") Set Cel = Cells.Find(what:=Choix) ColChoix = Cel.Column Cells(3, ColChoix).Resize(Cells(Rows.Count, ColChoix).End(xlUp).Row).Select 'filtre de base ActiveCell.AutoFilter Field:=ColChoix, Criteria1:="P", Operator:=xlOr, Criteria2:="X" ActiveCell.AutoFilter Field:=16, Criteria1:="External" ActiveCell.AutoFilter Field:=12, Criteria1:="TFU" 'filtres complementaires et majour tableau 'Worksheets("AL Extract").Range(TCel(n)).Value = pl.Offset(2).Value ' copie valeur For n = 0 To LTCrit ActiveCell.AutoFilter Field:=11, Criteria1:=TCrit(n) Set pl = Intersect([A2].CurrentRegion, Union([L:L], [M:M], [N:N], [AF:AF], [AG:AG])) pl.Offset(2).Copy Sheets("AL Extract").Range(TCel(n)) Next n With Worksheets("AL Extract") .Rows("5:500").Interior.Pattern = xlNone .EnableSelection = xlNoRestrictions .Protect contents:=True, userinterfaceonly:=True, AllowFiltering:=True, AllowFormattingCells:=True .Activate End With Set pl = Nothing 'Tout à la fin, après avoir fait tous les systèmes With Sheets("External TFU-TDO") If .AutoFilterMode Or .FilterMode Then .ShowAllData End With End Sub-
Re,
Pour l'encadrement des donnees copiees, il y a une colonne qui n'a pas cet encadrement vu qu'elle ne fait pas partie de la copie, faut ou faut pas d'encadrement?
Je ne comprends pas ce que vous vouliez dire ? La colonne qui ne fait pas partie de la copie c'est la 11ème, celle des systèmes
1- Quand vous définissez TCrit et TCel, on est sur la feuille Al Extract ? De plus les Dim TCrit et Dim Tcel sont incomplets, non , "as range" manqué il me semble.
2- Que signifie ci-dessous UBound? Le plus grand indice possible pour la plage Tcrit? Soit colonne DC sur la feuille "Al Extract", la 107ème colonne. OU est-ce le nombre de valeurs listées dans Array (de water & Waste à Cabin & crew rest, soit 17 en comptant les 2 type de Lights) ? A lecture de la suite je penche + pr cette 2ème réponse.
LTCrit = UBound(TCrit)
3- Dans ce bout de macro je ne comprends pas les lignes en gras:
With Worksheets("AL Extract")
.Rows("5:500").Interior.Pattern = xlNone
.EnableSelection = xlNoRestrictions
.Protect contents:=True, userinterfaceonly:=True, AllowFiltering:=True, AllowFormattingCells:=True
.Activate
End With
Set pl = Nothing
4- Et pour finir quand je teste: j'ai un msg d'erreur Run time error '9': Subscript out of range. Et la ligne surlignée en jaune est : pl.Offset(2).Copy Sheets("AL Extract").Range(TCel(n)). ceci dit les tableaux sont bien copies-collés sur la feuille AL Extract.
Cf fichier joint: http://www.cjoint.com/c/GFim5GREmZQ
Merci de votre aide et de votre patience, c'est déjà super !!
Dianex- Re,
1- as variant oui, mais pas autre chose
2- nombre de valeur dans le tableau en partant de 0
3- Vous ecrit quelquepart: pas de remplissage cellule (orange et autre(s)). Cette ligne de code enleve le remplissage cellule des x tabelaux de la feuille AL Extract en partant de la ligne 5 a 500.
4- je regarde
Suite
4-Si vous ajouter une valeur a un tableau TCrit ou TCel, il faut aussi ajouter un valeur au deuxieme
fichier que j'avais
TCrit = Array("Water & Waste", "Smoke Detection", "Seats", "SCS", "Pax Door", "Oxygen", "Lights*", "Lavatories" _
, "IFE", "Heating", "Galley/gains", "Emergency Systems", "Cockpit", "CIDS", "Cargo")
LTCrit = UBound(TCrit)
TCel = Array("B5", "I5", "P5", "W5", "AD5", "AK5", "AR5", "AY5", "BF5", "BM5", "BT5", "CA5", "CH5", "CO5", "CV5")
fichier que vous testez:
TCrit = Array("Water & Waste", "Smoke Detection", "Seats", "SCS", "Pax Door", "Oxygen", "Lights*", "Lavatories" _
, "IFE", "Heating", "Galley/gains", "Emergency Systems", "Cockpit", "CIDS", "Cargo", "Cabin & crew rest")
LTCrit = UBound(TCrit)
TCel = Array("B5", "I5", "P5", "W5", "AD5", "AK5", "AR5", "AY5", "BF5", "BM5", "BT5", "CA5", "CH5", "CO5", "CV5") en manque une valeur ici, la cellules de pose pour la derniere valeur de TCrit - Re,
1 et 2- Ok compris
4- Ah oui, c'est vrai ! Je n'ai pas vérifié jusqu'au bout pour la TCel.
3- Ok pour le remplissage, top!
Et la ligne Set pl = Nothing ? Que signifie t elle ? Cette affectation se fait après que tous les sytèmes (Water & waste, ..., Cabin & crew rest) aient été calculés ?
Déjà le résultat est nickel; mille mercis; il n y a meme plus d'erreurs !! Mais je n'ai vu nul part le fameux "On error resume next"; avez vous trouvé autre chose ?
Pour ce qui est de la mise en forme, je souhaitais conserver celle des tableaux prepares sur la sheet AL extract. Un peu grisé avec les bordures blanches; c'est la même que le doc powerpoint où tous ces tableaux générés doivent etre copiés. Là on a perdu la coloration orange / jaune, mais le fonf est devenu blanc et ma bordure, noire...
Je vais chercher de mon côté toute cette partie mise en forme, ainsi que trasfert de excel à powerpoint; et je reviendrais en quete de vos précieux conseils, si vous êtes ok ?
Mille mercis à tous,
Dianex - Re,
Et la ligne Set pl = Nothing
Normalement, quand vous affectez une variable par Set x=......, vous devez la desaffectee par Set x=Nothing pour liberer la memoire
Mais je n'ai vu nul part le fameux "On error resume next"; avez vous trouvé autre chose ?
Y en a pas besoin. La proposition de code de eriiic fait qu'il ny a pas d'erreur puisque copier rien dans rien ca donne rien
Pour ce qui est de la mise en forme, je souhaitais conserver celle des tableaux
Il faut faire les bordure tableau par tableau (c'est assez simple,bon courage)
Là on a perdu la coloration orange / jaune
Vous avez demandez pas de remplissage couleur, donc pas de couleur
si vous êtes ok ?
Oui, pas de probleme
-
-
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
Bonjour, bonjour !
Je reviens avec quelques avancées et toujours et encore des questions.
Ici le nouveau fichier: https://www.cjoint.com/c/GFum4CcJAGT
Et le code principal:
Sub Col_Select_ENGIN(Choix)
Dim Cel As Range
Dim ColChoix As Long
Dim TCrit As Variant
Dim LTCrit As Long
Dim TCel As Variant
Dim pl As Range
TCrit = Array("Water & Waste", "Smoke Detection", "Seats", "SCS", "Pax Door", "Oxygen", "Lights*", "Lavatories" _
, "IFE", "Heating", "Galley/gains", "Emergency Systems", "Cockpit", "CIDS", "Cargo", "Cabin & crew rest")
LTCrit = UBound(TCrit)
TCel = Array("B5", "I5", "P5", "W5", "AD5", "AK5", "AR5", "AY5", "BF5", "BM5", "BT5", "CA5", "CH5", "CO5", "CV5", "DC5")
'With Worksheets("AL Extract")'LIGNES PRESENTES DANS LA VERSION 2 MAIS A PRIORI PAS NECESSAIRE SI AUTANT D ONGLETS QUE DE AL
' .Unprotect
' .Rows("5:500").Cells.Clear
'End With
Worksheets("External TFU-TDO").Activate
'Sélection de la colonne en fonction de son en-tête type Set Cel = Cells.Find(what:="MAU")
Set Cel = Cells.Find(what:=Choix)
ColChoix = Cel.Column
Cells(3, ColChoix).Resize(Cells(Rows.Count, ColChoix).End(xlUp).Row).Select
'filtre de base
ActiveCell.AutoFilter Field:=ColChoix, Criteria1:="P", Operator:=xlOr, Criteria2:="X"
ActiveCell.AutoFilter Field:=16, Criteria1:="External"
ActiveCell.AutoFilter Field:=12, Criteria1:="TFU"
'filtres complementaires et majour tableau
'Worksheets("AL Extract").Range(TCel(n)).Value = pl.Offset(2).Value ' copie valeur
For n = 0 To LTCrit
ActiveCell.AutoFilter Field:=11, Criteria1:=TCrit(n)
Set pl = Intersect([A2].CurrentRegion, Union([L:L], [M:M], [N:N], [AF:AF], [AG:AG], [AI:AI]))
'Dim ALComboBoxVal As String (with Elena)
'ALComboBoxVal = ComboBoxAL.Item (with Elena)
pl.Offset(2).Copy Sheets(Choix).Range(TCel(n))
'pl.Offset(2).Copy Sheets("AL Extract").Range(TCel(n))
Next n
With Worksheets(Choix)
'.CurrentRegion.Interior.Color = RGB(238, 236, 225)--> erreur
'.UsedRange.Rows("5" & ActiveSheet.UsedRange.Rows.Count).Interior.Color = RGB(238, 236, 225) --> laisse le remplissage initial (orange/banc), pas ce que je souhaite
'.UsedRange.Rows("5" & ActiveSheet.UsedRange.Rows.Count).Borders.Color = RGB(255, 255, 255)
.Rows("5:100").Interior.Color = RGB(238, 236, 225)
.Rows("5:100").Borders.Color = RGB(255, 255, 255)
.EnableSelection = xlNoRestrictions
.Protect contents:=True, userinterfaceonly:=True, AllowFiltering:=True, AllowFormattingCells:=True
.Activate
End With
Set pl = Nothing
'Tout à la fin, après avoir fait tous les systèmes pour la AL choisie
With Sheets("External TFU-TDO")
If .AutoFilterMode Or .FilterMode Then .ShowAllData
End With
End Sub
J'ai trouvé plus simple de preparer des onglets pour chaque client, chaque onglet ayant le nom exact du client choisi dans la ComboBox. Plutôt que de tout centraliser sur la feuille "AL Extract" où les données doivent être effacées à chaque fois qu'on change de client (feuille qui n'existe donc plus dans cette version 3). Cela permettra de faire un copier-coller avec lien des tableaux édités sur l'onglet "QTR" par exemple sur le document PPT correspondant à QTR. Et ainsi de suite, un onglet Excel par client --> copier-coller sur le doc PPT dudit client. On évite ainsi le VBA qui copie-colle de Excel à Ppt.
Ce qui ne fonctionne pas:
1- comme vous pouvez le voir sur l'onglet QTR je n'ai pas su limiter la mise en page (remplissage et bordure) aux tableaux, du coup ce sont les lignes 5 à 100 qui sont affectées. Cela ne fait pas très proper
2- De plus en essayant de copier-coller avec liaison un tableau sur un doc PPT, je me rends compte que les seuls changements pris en compte sont ceux compris dans les cellules déjà presents dans le tableau Excel. CAD que si une ligne vient à être ajoutée elle n'est pas ajoutée en suivant sur Ppt.
Merci d'avance de votre aide pour pallier à ces 2 difficultés.
Dianex -
Bonjour,
Ok, je regarde la chose, mais pas avant demain-
-
Bonjour,
Aie, merci de votre réactivité mais ce site est bloqué par les pare-feux de ma boite... Pourriez-vous svp le mettre sur cjoint.com ?
EDIT: une question:
Normalement vous n'avez plus besoin de l'UF ALChoice, mais c'est vous qui voyez
--> En soi j'en ai toujours besoin pour choisir le client et lancer la macro pour éditer les tableaux sur le bon onglet, n'est ce pas? Ceci dit il est effectivement inutile et redondant (1/chaque onglet de client). Il me semble qu'il serait simple de le déplacer sur la page HOME où l'utilisateur a tous les autres boutons de commandes. Qu'en pensez-vous ? Je le teste déjà dans tous les cas.
LAST EDIT: le document PPT: http://www.cjoint.com/c/GFviEUl2ScY
Merci bcp !- Bonjour,
fichier meise en forme tableaus
https://www.cjoint.com/c/GFvjpY5kkwf
Il me semble qu'il serait simple de le déplacer sur la page HOME où l'utilisateur a tous les autres boutons
Vu sous cet angle, oui ce serait pas mal
Je recupere le PPT et vous tiens au courant
Suite:
PPT: vous avez mis trois criteres sur certain(s) slide(s), si par hazard plus de lignes que prevu, que se passe-t-il????????????????????????
-
Re,
PPT: vous avez mis trois criteres sur certain(s) slide(s),
--> Oui, quand il y a 3 systèmes sur certains slides c'est que ça suffisait pour ce client là. Vu que je le fais à la main jusqu'ici, j'ajuste le nombre de lignes selon. Pour ce client là, il ne devait dc pas y avoir bcp de sujets sur ces systèmes-là.
Mais c'est vrai qu'avec l'automatisation c'est plus dur à estimer et que passer à 2 par slide serait ptet plus judicieux... J'y réfléchirais..
Sinon je regarde votre nouvel input pour la MàJ tableau en début d aprèm.
Merci, @ plus tard
-
-
Re,
Voici la dernière version de doc fusionnant vos derniers input et les miens:
http://www.cjoint.com/c/GFvn4nO5ErY
C'est déjà super; je crois pouvoir dire que sur Excel cela fonctionne comme souhaité! Merci pr ça!
NB: je precise que les tab des clients (QTR et cie) sont invisibles à l'ouverture, il faut se mettre en mode MAINTENANCE avec le mot de passe = maintenance.
J'ai quand meme qlq questions pr bien comprendre le code:
1- je me la posais déjà il y a 15 jours: le Choix de Set Cel = Cells.Find(what:=Choix), ou encore de Set Cel = Cells.Find(what:=Choix), ou meme de With Worksheets(Choix) où j'ai tenté à tout hazard, d'où vient-il ?? Sauf erreur de ma part, je n'ai vu nul part où vous avez affecté qlq chose du type Choix = Choix de ComboBoxAL...
2- Merci de me confirmer la bonne compréhension ou de m'expliciter dans le cas contraire, avec un focus sur les ??:
For n = 0 To LTCrit
ActiveCell.AutoFilter Field:=11, Criteria1:=TCrit(n)
Set pl = Intersect([A2].CurrentRegion, Union([L:L], [M:M], [N:N], [AF:AF], [AG:AG], [AI:AI])) '?? On est sur la sheets(Choix), il me semble. Pquoi A2 et pas A1 ? la CurentRegion aurait été la même, non?
pl.Offset(2).Copy Sheets(Choix).Range(TCel(n)) '??
With Worksheets(Choix)
Plage = .Range(Left(TCel(n), Len(TCel(n)) - 1) & Rows.Count).End(xlUp).Row - 4 '?? je ne comprends pas plus; et c'est quoi, Len?
If Plage > 0 Then
.Range(TCel(n)).Resize(Plage, 6).Interior.Color = RGB(238, 236, 225)
.Range(TCel(n)).Resize(Plage, 6).Borders.Color = RGB(255, 255, 255)
End If
End With
Next n
Merci,
Dianex-
Re,
1_ je n'ai vu nul part où vous avez affecté qlq chose du type Choix = Choix de ComboBoxAL...
Appel de procedure avec parametre(s)
UF ALCHOICESub OK_Click() Unload Me 'écrire ici les noms des macros en cascades qui vont générer les tableaux Col_Select_ENGIN (ComboBoxAL.Value) 'puis celles qui vont copier-coller avec lien sur PPT à des emplacements définis (slide n°x...); la mise en forme doit être bonne! Toute proposition est bienvenue, me suis pas encore penchée dessus. End Sub
2_Pquoi A2 et pas A1 ? la CurentRegion aurait été la même, non?
Oui, mais j'ai choisi la ligne de filtre, vous, vous ferez ce que bon vous semble -
Bonjour,
1- Compris!
2- Ok pour la current region (et en fait on est sur la sheet des data "External TFU-TDO", j'étais un peu à côté de la plaque)
Désolée d'insister mais je reste bloquée sur cette ligne de code dont la partie en gras m'échappe vrmt mais que j'aimerais comprendre... Merci de vos éclaircissements.
With Worksheets(Choix)
Plage = .Range(Left(TCel(n), Len(TCel(n)) - 1) & Rows.Count).End(xlUp).Row - 4
3- Sinon plus ds les details, je souhaite que le mot de passe "maintenance" soit masqué avec des étoiles *** lorsque le user le rentre. Après recherches j'ai compris que c'est plus simple de le faire avec un UserForm plutôt qu'un Command Button comme c'est mon cas ici. Mais le format Command Button me convient vrmt mieux et je souhaite pouvoir le garder. Sur cette page https://forums.commentcamarche.net/forum/affich-33473929-cacher-le-mot-de-passe-vba vous apportiez la solution à quelqu'un. Je ne l'ai peut-être pas bien appliqué mais ça ne fonctionne pas dans mon projet. Que je mette votre code sur un module à part (HiddenPW) ou dans le module Command_Buttons qui contient la Sub Maintenancebutton_clic, ça ne fonctionne pas J'avais intuité que c'était un code universel mais je peux me tromper. Pourriez-vous l'ajuster au projet SVP ?
Ici la dernière version: http://www.cjoint.com/c/GFwokFtotYU
4- Je souhaite aussi que le lancement de "Select an airline" soit conditionné au mot de passe "maintenance" ; je l'ai tenté comme ci-dessous dans le module Command_buttons mais ça ne fonctionne pas. Une idée ?
Sachant qu'appeler Maintenancebutton_click dans la Sub AL_Choice() n'empechait pas le user form de s'ouvrir en cas de mot de passe faux.
Sub AL_Choice()
Dim mdp As String
mdp = InputBox("Password:")
Application.ScreenUpdating = False
' If user writes wrong password
If mdp <> "maintenance" Then GoTo WrongPassword
On Error Resume Next
Application.ScreenUpdating = True
Exit Sub
Wrongmdp:
Application.ScreenUpdating = True
MsgBox ("Sorry, the password is wrong. You have to enter the right one to automatically generate newsletters.")
' Choose the airline for which you want TFU extract
ALChoice.Show
End Sub
5- Je recupere le PPT et vous tiens au courant
Suite:
PPT: vous avez mis trois criteres sur certain(s) slide(s), si par hazard plus de lignes que prevu, que se passe-t-il????
--> si vous avez plus d'infos, n'hésitez pas !:)
Merci bcp,
Dianex -
Bonjour,
5- J'ai ce qu'il faut pour remplir vos slides automatiquement. Apres quelques tests ca marche. Il me reste a modifier votre fichier excel pour modifier votre pptx
Que fais je, je vous passe le code de base que j'ai ecrit et vous vous lancez ou je fais la modif dans votre dernier fichier ???
2- Facile pourtant !!!!!!!For n = 0 To LTCrit ActiveCell.AutoFilter Field:=11, Criteria1:=TCrit(n) 'filtre Set pl = Intersect([A1].CurrentRegion, Union([L:L], [M:M], [N:N], [AF:AF], [AG:AG], [AI:AI])) 'mise en memoire plage colonnes pl.Offset(2).Copy Sheets(Choix).Range(TCel(n)) 'copie plage a l'adresse prevu pour ce tableau With Worksheets(Choix) 'ex: n=4 '--->TCel(4)="AD5" 'pour recuperer la colonne: gauche(TCel(4), nombre de caracteres dans TCel(4) - 1)="AD" 'Left(TCel(4), Len(TCel(4)) - 1) ="AD" 'derniere cellule non vide colonne "AD" '.Range(Left(TCel(4), Len(TCel(4)) - 1) & Rows.Count).End(xlUp).Row=x pour le critere en cours 'je fais un -4, car la plage a mettre en forme debut en ligne 5 Plage = .Range(Left(TCel(n), Len(TCel(n)) - 1) & Rows.Count).End(xlUp).Row - 4 'longueur plage tableau a mettre en forme If Plage > 0 Then .Range(TCel(n)).Resize(Plage, 6).Interior.Color = RGB(238, 236, 225) .Range(TCel(n)).Resize(Plage, 6).Borders.Color = RGB(255, 255, 255) End If End With Next n
3 & 4- je regarde la chose
Suite:
Pour le 5-: si vous voulez kake chose plus ExcelPlage = Range(Split(Range(TCel(n)).Address, "$")(1) & Rows.Count).End(xlUp).Row - 4
-
Re,
Suite:
3-
Mais le format Command Button me convient
Plait-il ?
3--Password = InputBoxDK("Password:")et
4-mdp = InputBoxDK("Password:")
Manquait DK -
Bonjour,
2- Merci, c'est bien plus clair ! :)
3- Je disais qu'idéalement je ne souhaitais pas modifier le type de bouton pour "Maintenance" (qui est un command button) en un User Form. C'est plus pr de l'esthétique... Et vu que selon votre ancien post ça semblait possible...
--> Password = InputBoxDK("Password:") --> Merci bcp pour cette solution, ça marche très bien pour le bouton maintenance!
4- Mais après divers tests ce n'est pas aussi bien pour le bouton "Select an airline"... Le mot de passe 'maintenance' m'est bien demandé mais qu'il soit correct ou non je n'ai pas accès à la proposition de selection des clients (QTR et cie)... De plus vu que je fais d'abord appel à Maintenancebutton_click, j'ai 2 msg qui annoncent que le mdp est faux (quand il l'est); et ce msg "The password is wrong. You have to enter the right password to be allowed to automatically generate newsletters." quand il est juste... Pas réussi à aller au dela.
EDIT: Fichier dernière version : http://www.cjoint.com/c/GFxnqYup240
Sub AL_Choice()
Dim mdp As String
'mdp = InputBoxDK("Password:")
'Application.ScreenUpdating = False
Maintenancebutton_click
If mdp <> "maintenance" Then GoTo Wrongmdp
On Error Resume Next
Application.ScreenUpdating = True
Wrongmdp:
Application.ScreenUpdating = True
MsgBox ("The password is wrong. You have to enter the right password to be allowed to automatically generate newsletters.")
Exit Sub
'On Error Resume Next
'Application.ScreenUpdating = True
' Choose the airline for which you want TFU extract
ALChoice.Show
End Sub
5- J'ai ce qu'il faut pour remplir vos slides automatiquement. Apres quelques tests ca marche. Il me reste a modifier votre fichier excel pour modifier votre pptx. Que fais je, je vous passe le code de base que j'ai ecrit et vous vous lancez ou je fais la modif dans votre dernier fichier ???
--> je voudrais tenter dans un 1er temps, le but c'est de progresser ^^ Ou si possible les 2, comme ça j'ai l'exercice à tous et la correction... :)
Merci, merci!
Dianex
-
-
Bonjour,
Bonjour,
1/ Dans le fichier que j'ai modifie,
Remplacement_Tableaux_PPTX(Choix)
est appele dans
Sub Col_Select_ENGIN(Choix)
'mise ajour PPTX
Call Remplacement_Tableaux_PPTX(Choix)
2/ Est ce que *CHOIX* marcherait ?
Ah! Que non.....Vu qu'il n'y a qu'une partie du titre qui change, mieux comme ceci
Set PptDoc = PptApp.Presentations.Open("D:\_Dianex87\" & Choix & " master presentation review.pptx")
3/ Que faire pour meilleur presentation?
东西或不-
Re,
1- Oui effectivement, je l'ai vu après coup.
2- Merci pr le tuyau, jai modifié le code en ce sens, mais SANS SUCCES, j'ai tjrs le msg d'erreur sur la ligne surlignée en jaune Set PptDoc = PptApp.Presentations.Open("C:\Users\pokossy_d\Desktop\KPI - Improve TFU and ISI Excel File\" & Choix & " master presentation review.pptx"); comme quoi le PPT ne peut pas être ouvert. Le code ne va donc pas plus loin, POURQUOI ?
--> Dernière version dispo ici: http://www.cjoint.com/c/GFBnmv7VTcQ
Autrement pourriez-vous SVP répondre à mes questions sur les lignes non-comprises (cf. questions dans le code inclus dans le message 44) ?
Merci f894009 ! -
Re,
Set PptDoc = PptApp.Presentations.Open("C:\Users\pokossy_d\Desktop\KPI - Improve TFU and ISI Excel File\" & Choix & " master presentation review.pptx")
Chez moi avec le fichier precedent et "mon" chemin ca marche. Z'etes sure que le chemin est le bon et le texte apres Choix aussi ???????
Autrement pourriez-vous SVP répondre à mes questions sur les lignes non-comprises (cf. questions dans le code inclus dans le message 44) ?
Ok, je regarde pour plus d'explications
Suite:
fichier explications:https://www.cjoint.com/c/GFBq0bWjKKf
Normalement a la fin d'un projet, il faut reprendre tout le code pour faire des modif sur des lignes comme je vous explique dans le fichier explication -
Hello,
Chez moi avec le fichier precedent et "mon" chemin ca marche. Z'etes sure que le chemin est le bon et le texte apres Choix aussi ???????
--> oui oui, je copie-colle le chemin donc si ça marche chez vous ça devrait marcher aussi mais non, je ne comprends pas :-/ Je pourrais creuser ça demain
Mais surtout merci bcp pour les explications !! Bon il reste encore des ?? mais je suppose que vous avez répondu à ce qui vous paraissait essentiel :)
Et merci de votre temps sur toutes ces semaines! Je vais garder le post encore ouvert qlq temps pour venir à bout de ce qui ne marche pas super. Comma ça si gros pb je me permettrais de vous solliciter, autrement je mettrais le post en résolu!
Dianex87 -
-
Re,
Dites après lecture d'un post sur le sujet qui me turlupine (mon pptx qui ne s'ouvre tjrs pas à la fin de la macro :-( ) je me demandais un peu naivement s'il n y avait rien à faire sur l'interface VBA du PPT ? Et que vous ne me l'aviez pas dit pcq evident pour vous mais pas pr moi ?...
Oui et non, je ne sais pas ce que vous ne connaisse pas.
--> eh bien dans le code j'avais mis pas mal de questions auxquelles vous n'avez pas réagi; ells vous ont peut etre échappé vu qu'il est très dense...
EDIT: désormais le PPT s'ouvre bien, mais les modifications ne se font pas dessus. La macro cale à la ligne suivante avec un msg d'erreur qui dit run time eeror... Shapes.Paste: Invalid request. Clipboard is empty or contains data which may not be pasted here. Sachant que ce qu'il y a dans le clipboard c'est le 1er tableau à coller, pr le Water & waste, dc il n est pas vide..Slides(NSlide).Shapes.Paste
J'ai rajouté la ligne Application.CutCopyMode = False juste en dessous mais meme erreur au meme endroit... Une idée du pb SVP ?
Merci
-
