[Calc] Création de multiples ODS à partir de filtres

Discussions et questions sur tout ce qui concerne la programmation tous langages et tous modules confondus.

Modérateur: Vilains modOOs

Règles du forum
:alerte: Balisage obligatoire dans cette section !
Aidez-nous à vous aider au mieux en balisant correctement votre question : reportez-vous sur les règles de cette section avant de poster !

[Calc] Création de multiples ODS à partir de filtres

Messagepar Orsu » 29 Avr 2018 18:26

Bonjour

Extreme néophyte en macro libre office, je voudrais automatiser un process qui me prend pas mal de temps et j’aurais vraiment besoin de compétences…. :fou:

Alors voilà, j’ai dans un fichier calc, qui peut faire plusieurs dizaines de lignes , des données que je voudrais regrouper dans des classeurs (ou à la limite feuilles) distinct(e)s en fonction d’un critère qui peut éventuellement changer en fonction des besoins : en d’autres termes, parfois le critère sera en colonne B, parfois en D, etc.

Ce que je voudrais donc :
1/ dans un premier temps, sélectionner via une msgbox la cellule (1ere ligne de colonne) contenant le critère en fonction duquel les classeurs seront créés : l’idée est que chaque classeur créé regroupe les données de la feuille qui répondent au même critère
Accessoirement,si c’est possible, mettre une option de contrôle permettant de s’assurer que le critère de création n’est pas farfelu (cellule vide, cellule de la 2eme ligne au lieu de la 1ere, etc...)
2/ créer les classeurs (par hypothèse dans le même emplacement que le fichier d’origine)
3/ si possible, les nommer selon la norme suivante : nom du fichier d’origine - item de la clé de tri retenue


Il me semble que cela pourrait passer par les sous étapes suivantes (en tout cas c’est ± le process de la macro que j’avais avant sous excel… : si ca peut servir, j’ai gardé le code):

a) pour chaque item de la clé de tri
. filtrer la feuille d’origine en fonction de l’item
. copier la sélection
. créer un classeur nommé (nom du fichier d’origine - item de la clé de tri retenue)
. nommer la 1er feuille de la même manière
. coller la sélection dans la feuille du classeur créé
. enregistrer le nouveau classeur ainsi créé

b) réinitialiser les filtres du classeur d’origine

b) passer au second item de la clé de tri et recommencer jusqu’au dernier item

Pour mémoire, j’ai tenté avec l’enregistreur de macros mais c’est lourd, long inélégant et…. peu satisfaisant.

Voilà, je sais que c’est compliqué ….mais si quelqu’un veut faire une BA pour tout ou partie du besoin, un grand merci d’avance !

A toutes fins utiles, je joins un exemple du classeur « de base » qui nécessite d’être exploité.
Pièces jointes
REGIES_PF.ods
(35.74 Kio) Téléchargé 10 fois
Libreoffice 5-2-5-1
OSX El Capitan 10.11.6
Orsu
Fraîchement OOthentifié
 
Message(s) : 1
Inscrit le : 29 Avr 2018 18:10

Re: Création de classeurs multiples à partir de filtres d'un

Messagepar Bidouille » 30 Avr 2018 08:50

Cette section a des règles très précises que vous devez obligatoirement suivre pour obtenir de l'aide. C'est indiqué dans le cadre rouge en haut de la page.

Il est demandé aux auteurs de faire précéder le titre de leur question d'une balise adéquate. Ce balisage est extrêmement important car il permet d'avoir une base de connaissance optimum en cas de recherche. Avez-vous remarqué comment étaient les autres questions postées ?

Lisez ce fil pour savoir quelle balise utiliser : sutra27295.html#27295

Nous l'avons fait pour vous cette fois-ci mais lors de votre prochaine question, nous vous remercions de le faire vous-même sous peine de voir votre sujet verrouillé.
Avatar de l’utilisateur
Bidouille
RespOOnsable forum
RespOOnsable forum
 
Message(s) : 9772
Inscrit le : 08 Nov 2005 17:23
Localisation : Brest, France

Re: [Calc] Création de multiples ODS à partir de filtres

Messagepar Piaf » 01 Mai 2018 13:56

Bonjour
Une solution éventuelle à tester. (J'ai du supprimer tous les espaces indésirables dans tes données).
Code : Tout sélectionner   AgrandirRéduire
REM  *****  BASIC  *****
Dim oDlg as Object
Global numCol as Long
Dim maFeuille as Object
Dim valFiltre as Variant

Sub Regies
Dim oDoc as Object, NomFeuille() as String, oCol as Variant, i as Integer
   oDoc = thisComponent
   maFeuille = oDoc.CurrentController.ActiveSheet
   DialogLibraries.LoadLibrary("Standard")
   oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
   oCol = Array("A","B","C","D","E","F","G","H")
   oDlg.getControl("lstCol").Model.StringItemList = oCol()
   oDlg.Execute
End Sub

Sub lesFiltres(oEv as Object)
Dim maZone as Object
Dim CellVide as Variant, y as Long, i as Integer
   NumCol = oEv.Source.SelectedItemPos
   maZone = maFeuille.getCellRangeByPosition(NumCol,1,numCol,500)
   CellVide = maZone.queryEmptyCells.RangeAddresses
   y = cellVide(UBound(cellVide)).StartRow -1
   For i = 1 To y
      redim Preserve tabFiltre(i - 1)
      tabFiltre(i - 1 ) = maFeuille.getCellByPosition(NumCol,i).String
   Next i
   tabFiltre = SortedList(tabFiltre,True)
   For i = LBound(tabFiltre) To UBound(tabFiltre)
      AppliquerFiltre(tabFiltre(i))
   Next i
   oDlg.EndExecute
End Sub

Sub AppliquerFiltre(oFiltre as Variant)
Dim oFilterDesc, FeuilleCopy as Object, maCellule as Object
Dim oFields(0) As New com.sun.star.sheet.TableFilterField
   oFilterDesc = maFeuille.createFilterDescriptor(True)
   With oFields(0)
      .Field = NumCol
      valFiltre = oFiltre
      If isnumeric(oFiltre) Then
         .IsNumeric = True
         .NumericValue = oFiltre
      Else
         .IsNumeric = False
         .StringValue = oFiltre
      End If
      .Operator = com.sun.star.sheet.FilterOperator.EQUAL
   End With
   With oFilterDesc
      .setFilterFields(oFields())
      .ContainsHeader = True
      .CopyOutputData = True
      FeuilleCopy = thisComponent.Sheets.getByName("Copy")
      maCellule = FeuilleCopy.getCellRangeByName("A1")
      .OutputPosition = maCellule.CellAddress
   End With   
   maFeuille.filter(oFilterDesc)
   ThisComponent.Store(True)
   CopySheet
End Sub
'https://forum.openoffice.org/fr/forum/viewtopic.php?f=8&t=57665&p=311473&hilit=copier+feuille#p311473 par Hubert Lambert
Sub CopySheet()
Dim Chemin as Variant, destDoc as Object, destSheet as Object
Dim SourceURL as String
Dim Arg(0) As New com.sun.star.beans.PropertyValue
Dim gomme as Long
   Chemin = Split(ThisComponent.URL,"/")
   Chemin(UBound(Chemin)) = ""
   Chemin = Join(Chemin,"/")
   Arg(0).Name = "Hidden"
   Arg(0).Value = True   
   destDoc = StarDesktop.LoadComponentFromURL("private:factory/scalc", "_default", 0, Arg())
   destSheet = destDoc.Sheets(0)
   If InStr(valFiltre," ") > 0 Then
      valFiltre = Join(Split(valFiltre," "),"_")
   End If   
   If InStr(valFiltre,"/") > 0 Then
      valFiltre = Join(Split(valFiltre,"/"),"_")
   End If
   destSheet.setName(valFiltre)
    sourceURL = convertToURL(Chemin & Split(thisComponent.Title,".")(0) & "_" & valFiltre & ".ods")
    destSheet.link(thisComponent.URL, "Copy", "", "", com.sun.star.sheet.SheetLinkMode.NORMAL)
    destSheet.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
    destSheet.LinkURL = ""
    destDoc.storeToURL(sourceURL,Array())
    destDoc.Close(True)
    gomme = com.sun.star.sheet.CellFlags.HARDATTR + _
   com.sun.star.sheet.CellFlags.STRING + _
   com.sun.star.sheet.CellFlags.VALUE
   thisComponent.sheets.getByName("Copy").clearContents(gomme)
End Sub

'https://forum.openoffice.org/fr/forum/viewtopic.php?f=8&t=42864&p=234425&hilit=trier+un+tableau#p234416 par alhazred
    'Tri rapide : séparer en deux, trier les parties, les imbriquer
    'noDouble = true pour supprimer les doublons
    'les indices commencent à 0
Function SortedList(list, noDouble As Boolean)
Dim ub%
   ub = UBound(list)
   If ub<1 Then
      SortedList = list
      Exit Function
   End If
             
Dim ub1%, list1, list2
       
       'Diviser la liste en deux
   ub1 = ub\2
   list1 = ListSegment(list,0,ub1)
   list2 = ListSegment(list,ub1+1,ub)
       
       'Trier les parties
   list1 = SortedList(list1,noDouble)
   list2 = SortedList(list2,noDouble)
       
       'Les imbriquer
   SortedList = SortedUnion(list1,list2,noDouble)
End Function

    '************************************************************************
    'Former une nouvelle liste en prenant à chaque fois le plus petit élément.
Function SortedUnion(list1, list2, noDouble As Boolean)
Dim i1%, ub1%, elem1, i2%, ub2%, elem2, i%, ub%, elem
   ub1 = Ubound(list1)
   ub2 = UBound(list2)
   ub = ub1+ub2+1
Dim list(0 To ub)
       
       'i1 = 0 : i2 = 0 : i = 0 'inutile
   While i1<=ub1 And i2<=ub2
      elem1 = list1(i1)
      elem2 = list2(i2)
      If noDouble And elem1=elem2 Then
         list(i) = elem1
         i1 = i1+1
         i2 = i2+1
      ElseIf elem2<elem1 Then '<--- ici pour changer le mode de tri
         list(i) = elem2
         i2 = i2+1
      Else
         list(i) = elem1
         i1 = i1+1
      End If
         i = i+1
   Wend
       
       'Une des listes est épuisée : compléter avec les éléments restants de l'autre liste
   If i2<=ub2 Then
      For i2=i2 To ub2
         list(i) = list2(i2)
         i = i+1
      Next i2
   Else
      For i1 =i1 To ub1
         list(i) = list1(i1)
         i = i+1
      Next i1
   End If
       
       'Redimensionner si des doublons ont été éliminés
   If i<=ub Then Redim Preserve list(0 To i-1)
       
   SortedUnion = list
End Function

    '**********************************************************
    'Retourne la liste des éléments pour les indices de lb à ub
    'org (0 par défaut) est la base de la nouvelle liste
Function ListSegment(list, lb%, ub%, Optional org%)
   If IsMissing(org) Then org=0
       'décalage des indices
Dim delta% : delta = lb-org
       
Dim list1(org To ub-delta), i%
   For i = lb To ub
      list1(i-delta) = list(i)
   Next i
   ListSegment = list1
End Function
A+
Pièces jointes
REGIES_PF.ods
(20.38 Kio) Téléchargé 12 fois
Libre Office Version: 6.0.6 et Apache OpenOffice 4.1.5 Sur Xubuntu 18.04 AMD64
Piaf
GourOOu
GourOOu
 
Message(s) : 5390
Inscrit le : 25 Nov 2011 19:07
Localisation : Guyane


Retour vers Macros et API

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : El_Brouno et 14 invité(s)