Sujet Précédent Sujet Suivant

VBA Excel:comment formuler le end(xldown) d'1 union de colonnes?

Résolu/Fermé
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 - 30 mai 2017 à 16:06
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 - 7 juil. 2017 à 07:17
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 


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éponse 1 / 8
thev Messages postés 1969 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 17 mars 2025 710
31 mai 2017 à 00:11
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
 
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
31 mai 2017 à 11:12
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
31 mai 2017 à 12:19
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 ?
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
31 mai 2017 à 15:11
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
0
Réponse 2 / 8
thev Messages postés 1969 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 17 mars 2025 710
Modifié le 31 mai 2017 à 16:41
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.




 
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
7 juin 2017 à 15:01
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
7 juin 2017 à 15:49
Bonjour,

fichier modifie pour prendre en compte le choix fait dans lUF ALChoice

https://mon-partage.fr/f/Qa5YnoXJ/

Par contre sur certains choix, erreur car pas de ligne apres filtre!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
7 juin 2017 à 16:22
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!
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
7 juin 2017 à 16:28
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.
0
Réponse 3 / 8
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 257
Modifié le 7 juin 2017 à 23:56
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
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
8 juin 2017 à 11:58
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 8 juin 2017 à 12:01
Bonjour,

regardez le code que j'ai mis f894009 8 juin 2017 à 07:47
je suis parti de la proposition d'eriiic avec quelques modifs et ca marche tres bien
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
8 juin 2017 à 12:05
Bonjour,

Oui oui bien sur, je regarde, je répondais au plus simple dans un 1er temps !

A plus tard,

Merci encore!
0
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 257
8 juin 2017 à 12:11
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.
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024
8 juin 2017 à 12:39
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
0
Réponse 4 / 8
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713
Modifié le 8 juin 2017 à 08:24
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
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
8 juin 2017 à 14:57
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 8 juin 2017 à 15:21
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
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
8 juin 2017 à 16:02
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 8 juin 2017 à 16:12
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
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
9 juin 2017 à 10:40
OK,c'est noté.

@ plus tard donc,

Merci !
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
20 juin 2017 à 15:19
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
0
Réponse 6 / 8
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713
20 juin 2017 à 16:36
Bonjour,

Ok, je regarde la chose, mais pas avant demain
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
20 juin 2017 à 16:46
Quand vous pouvez bien sur, merci bcp !
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
20 juin 2017 à 17:36
Re,

Mise en forme tableaux

https://mon-partage.fr/f/QSKzjQBP/

Normalement vous n'avez plus besoin de l'UF ALChoice, mais c'est vous qui voyez
Pour la partie PPT, demain, mais si j'avais votre fichier powerpoint, ca irait mieux ou expliquez ce que vous attendez
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 21 juin 2017 à 10:32
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 !
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 21 juin 2017 à 11:19
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????????????????????????
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
21 juin 2017 à 11:44
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
0
Réponse 7 / 8
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
21 juin 2017 à 16:13
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713
21 juin 2017 à 16:45
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 ALCHOICE 
Sub 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
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
22 juin 2017 à 16:10
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 22 juin 2017 à 17:30
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 Excel 
Plage = Range(Split(Range(TCel(n)).Address, "$")(1) & Rows.Count).End(xlUp).Row - 4
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
Modifié le 22 juin 2017 à 17:50
Re,

Suite:
3-
Mais le format Command Button me convient
Plait-il ?

3-
-Password = InputBoxDK("Password:")
et
4-
mdp = InputBoxDK("Password:")


Manquait DK
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
Modifié le 23 juin 2017 à 15:17
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
0
Réponse 8 / 8
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713
Modifié le 27 juin 2017 à 11:41
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?
东西或不
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
27 juin 2017 à 15:21
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 !
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
Modifié le 27 juin 2017 à 18:53
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
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
29 juin 2017 à 09:21
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
0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713 > Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017
29 juin 2017 à 09:25
Bonjour,

mais je suppose que vous avez répondu à ce qui vous paraissait essentiel
Oui et non, je ne sais pas ce que vous ne connaisse pas. Ce n'est pas chinois, mais s'en faut de peu
0
Dianex87 Messages postés 79 Date d'inscription jeudi 9 mars 2017 Statut Membre Dernière intervention 8 août 2017 > f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025
Modifié le 29 juin 2017 à 16:39
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
0