Microsoft 365 créer onglets en automatique a partir d'une BDD

[dd_76]

Bonjour,

Besoin de votre aide : je cherche a automatiser des fiches d'émergements.
j'ai une base de données, qui calcul un nom de chéquier par adultes et enfants
Je souhaite faire une feuille d'émergement en automatique
les critères de regroupement sont :
Agence et le site (toutes les personnes de la même agence et du même site devront être sur la même feuille)
avoir le total de chéquier par nom prénom (col B et C) pour adultes et pour enfant.

j'aimerais
- un onglet unique : ou avec deux liste déroulante ou l'on peut choisir l'agence et le site

et un bouton qui permet d'imprimer un pdf dans un dossier

j'espère avoir été claire 😉
un grand merci de votre aide par avance

 

[Xl60PassionFr]

Donjour dd_76,

Voici une possibilité avec formules O365 et petites macros 😉

A+

 

[dd_76]

Donjour dd_76,

Voici une possibilité avec formules O365 et petites macros 😉

A+

super sur la construction du tableau c'est ce que j'avais fait. j'ai même intégré la formule UNIQUE
par contre la macro au top car je maitrise moins le codage et j'étais en galére
merciii

 

[fanch55]

N'oubliez pas de marquer la demande comme résolue .

Avez vous vu...? Discussion 'marquer comme résolu'

14 Février 2023

Bonjour
comment mettre une discution comme résolu
d avance merci à vous tous

• pierre dupont

 

[dd_76]

Donjour dd_76,

Voici une possibilité avec formules O365 et petites macros 😉

A+

Bonjour, je finalise le projet, y a t il possibilité d'avoir un code vba pour ajuster (en largeur, hauteur) en automatique les colonnes A, B et C de l'onglet Emargement
merci 😉

 

[job75]

Bonsoir dd_76, le fil,

Chez moi sur Excel 2019 les fonctions FILTRE et UNIQUE n'existent pas donc j'ai créé cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d1 As Object, d2 As Object, x$, c As Range, mem, L
Set d1 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
Set d2 = CreateObject("Scripting.Dictionary")
d2.CompareMode = vbTextCompare 'la casse est ignorée
x = LCase([B1])
For Each c In [Tableau1[Agence]] 'tableau structuré
    d1(c.Value) = ""
    If LCase(c) = x Then d2(c(1, 2).Value) = ""
Next c
With Sheets("Listes")
    .[A:B].ClearContents 'RAZ
    If d1.Count Then .[A1].Resize(d1.Count) = Application.Transpose(d1.keys)
    If d2.Count Then .[B1].Resize(d2.Count) = Application.Transpose(d2.keys)
End With
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
If IsError(Application.Match([E1], d2.keys, 0)) Then [E1] = ""
[B1:E1].Validation.Delete 'RAZ
[B1].Validation.Add xlValidateList, Formula1:="=Listes!A1:A" & d1.Count
[E1].Validation.Add xlValidateList, Formula1:="=Listes!B1:B" & d2.Count
[A4:D20].ClearContents 'RAZ
Rows.Hidden = False 'affiche toutes les lignes
With [Tableau1]
    .AutoFilter
    .AutoFilter 6, x '1er critère
    If [E1] <> "" Then .AutoFilter 7, [E1] '2ème critère
    Intersect(.SpecialCells(xlCellTypeVisible), Union(.Parent.[B:C], .Parent.[V:W])).Copy
    [A4].PasteSpecial xlPasteValues 'colle les valeurs
    Application.CutCopyMode = 0
    .AutoFilter 'affiche tout
End With
mem = [C4:C20]: [C4:C20] = [D4:D20].Value: [D4:D20] = mem 'inversion des colonnes
Target.Select
'---masque les lignes vides---
[A4:A20].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
'---ajustement des largeurs de colonnes---
[B1].UnMerge
Columns("A:D").AutoFit
[B1:C1].Merge
L = Columns("B").ColumnWidth
[B3:B20].Columns.AutoFit
If L > Columns("B").ColumnWidth + Columns("C").ColumnWidth Then Columns("B").ColumnWidth = L - Columns("C").ColumnWidth
Application.EnableEvents = True 'réactive les évènements
End Sub

Pour répondre à votre post #5 les largeurs des colonnes sont ajustées en fin de macro.

Pour tester modifiez les cellules B1 ou E1.

A+

 

[job75]

Dans la macro précédente j'ai ajouté le masquage des lignes vides.

 

[dd_76]

Dans la macro précédente j'ai ajouté le masquage des lignes vides.

Bonjour,
merci infiniment
1) j'ai intégré mes données dans l'onglet Base (j'ai 1105 lignes)
2) dans l'onglet émargement, j'ai ajouté des lignes pour que mon TOTAL chéquiers soit en ligne 640
3) je vais dans l'onglet émargement, pour choisir mon antenne et la macro bloque (je clique sur déblocage et en surbrillance jaune le début de la ligne 10 est jaune
If Lcase (c) = x then

 

[job75]

Bonjour le forum,

le début de la ligne 10 est jaune
If Lcase (c) = x then

A priori il y aurait une valeur d'erreur en colonne F de la feuille "Base", joignez votre fichier.

A+