XL 2013 Automatisme pour remplir des TABs

Dranreb

XLDnaute Barbatruc
Le classement souhaité est sur quelles colonnes ?
 

Sigmund173

XLDnaute Occasionnel
ou on utilise les coches dans folder owner et ça les mets automatiquement dans les différentes TABs ou alors on utilise pas les folder owner et donc les personnes vont devoir se taper chaque TAB et toutes les lignes
 

Dranreb

XLDnaute Barbatruc
Débrouillez vous avec ça :
VB:
Sub CocherFOwnCochés()
   Dim TR(), LR As Long, C As Long, Coché, Princ As SsGr, Perm As SsGr, Détail
   ReDim TR(1 To 10000, 1 To 9)
   For Each Princ In Gigogne(TableUnique(WshFolOwn.[A2:I2], ActiveSheet.[A2:I2]), 3, 2)
      For Each Perm In Princ.Co
         Coché = Empty
         For Each Détail In Perm.Co
            If Détail(0) = 0 Then
               Coché = Détail(9)
            Else
               LR = LR + 1
               For C = 1 To 8: TR(LR, C) = Détail(C): Next C
               TR(LR, 9) = Coché
               End If: Next Détail, Perm, Princ
   Application.EnableEvents = False
   ActiveSheet.[A2:I2].Resize(LR).Value = TR
   With ActiveSheet.[Flag]
      .Interior.Color = &HDBAEFF: .Offset(, -1).Interior.Color = &HF2CAFF: End With
   With ActiveSheet.[Flag].SpecialCells(xlCellTypeBlanks)
      .Interior.Color = &HB8FD00: .Offset(, -1).Interior.Color = &HBDFF9D: End With
   Application.EnableEvents = True
   End Sub
Correspondance et classement sur colonnes 3 et 2, "Principal" et "Permission".
 

Sigmund173

XLDnaute Occasionnel
merci je vais voir l'histoire de la correspondance et sinon je devrais pouvoir le modifier moi même
Je suppose que ce sont les deux critères pour copier la ligne et les différenciers si 2x la même donc même nom pour colonne 3 mais RO ou RW pour colonne 2. Si c'est ça c'est bon pour moi :)
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Pourriez vous me donner un classeur avec peu de données bidon comportant tous les cas, que je puisse reproduire l'incident afin de tester mes corrections ? Ce que j'ai gardé contient n'importe quoi, j'ai l'impressionh, et je n'ai toujours pas les test définitifs du Select Case True.
Mais vous pouvez toujours ajouter un On Error Resume Next devant, pour le cas où tout est coché.
 

Dranreb

XLDnaute Barbatruc
Non, mais je voudrais le garder, alors mettez juste autant de dossiers bidons qu'il faut pour qu'au pire un seul aille dans chaque WshDsp… par exemple en fonction des tests. Avez vous essayé en mettant On Error Resume Next devant l'instruction qui sélectionne toutes les cellules vide de [Flag] pour que ça ne plante plus l'exécution quand il n'y en n'a pas ?
 

Sigmund173

XLDnaute Occasionnel
Effectivement je l'ai fait et du coup ça me valide en rouge dans le TAB Folder Owner mais rien n'est coché dans les autres TAB

VB:
      On Error Resume Next
      With ActiveSheet.[Flag].SpecialCells(xlCellTypeBlanks)
 

Sigmund173

XLDnaute Occasionnel
Le bouton de pour la marco se trouve bien dans la feuille concerné, je l'ai mis dans Folder Owner
Est ce que ça pourrait venir du fait que dans folder owner, les membres sont aisni
pierre1,paul1,jacques2,...

Et quand dans les autres TAB
c'est dispatché correctement par nom seul
pierre1
paul1
....
 

Dranreb

XLDnaute Barbatruc
Alors pourquoi dites vous que ça modifie les coches de la feuille Folder Owner ?
Ça ne modifie que les coche de la feuille depuis laquelle on l'exécute en fonction de celles de la Folder Owner préalablement mises manuellement.
 

Sigmund173

XLDnaute Occasionnel
compris ... ce même bouton je dois le mettre aussi dans chaque feuille ... vu
un peu moins pratique, pas de souci je vais tester ça
 

Sigmund173

XLDnaute Occasionnel
maintenant on a tout pour exclure les dossiers et je viens de voir que lorsqu'on transforme en pdf, l'encadrement signature et business justification se trouve sur une autre page au lieu de la fin de la liste, une idée ?
Petite précision ceci arrive quand j'ai plus d'une page
S'il n'y a qu'une page dans le pdf, ça se trouve bien à la suite

VB:
LOt.DataBodyRange.Value = TR
   WshExclPDF.ResetAllPageBreaks
   If LR > 40 Then WshExclPDF.HPageBreaks.Add Before:=LOt.HeaderRowRange.Offset(LR + 1)
'   Application.EnableEvents = False
'      Do: DoEvents
   Application.PrintCommunication = False
   With WshExclPDF.PageSetup
      .FitToPagesWide = 1
      .FitToPagesTall = False
      .LeftHeader = WshSumm.[U2].Value
      .RightHeader = WshSumm.[D2].Value & vbLf & WshSumm.[D3].Value & vbLf & WshSumm.[D4].Value
      .CenterHeader = WshSrc.Name
      End With
   Application.PrintCommunication = True
'            Loop Until WshExclPDF.PageSetup.CenterHeader = WshSrc.Name
'   Application.EnableEvents = True
   WshExclPDF.ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:=ThisWorkbook.Path & "\Exclusion list " & WshSrc.Name & ".pdf", _
      Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=True
 
Dernière édition:

Sigmund173

XLDnaute Occasionnel
Une chose est certaine le fichier nous fait gagner un gain de temps énorme et surtout nous évite les erreurs manuel :-D
 

Dranreb

XLDnaute Barbatruc
Oui c'est sûr, on pourrait paufiner le test qui ajoute le saut de page en vue de ne pas couper l'encadrement,
genre : If LR Mod NbLpP > NbLpP - HEnc Then
avec au début : Const NbLpP = Nombre de lignes par page, HEnc = Hauteur en lignes de l'encadrement
au risque que ça ne marche plus si on diminue les marges de sorte qu'il y aura d'avantage de lignes par page et qu'on oublie de rectifier la valeur de NbLpP, ou si on modifie l'encadrement en oubliant de changer HEnc.
 
Dernière édition:

Discussions similaires


Haut Bas