XL 2013 Association Tableau récapitulatif membres + Fiches perso

YANOU38

XLDnaute Occasionnel
Bonjour le Forum,
J'ai récupéré ce code et essayé de le modifier...
Il permet, à partir du tableau de la Feuille "Base", de créer une Feuille par membre (en cliquant sur "Mise à jour")
Mon 1ier problème :
J'ai ajouté une ligne (sur "Base") pour mettre un titre à mon Tableau ""Saison 2021 - 2022".
Depuis, cela me créer une Feuille vierge "-" juste avant la Feuille "Modèle".
Comment y remédier ?
Mon 2ième problème :
J'ai ajouté une colonne K (sur "Base") "Réglé le", mais je n'arrive pas à ajouter la prise en compte de cette colonne dans la macro.
J'ai tenté un
VB:
Array("Réglé le", "Réglé le :", "B12") _
vers le début du code, mais cela ne fonctionne pas.
J'ai tenté d'augmenter le nombre de champs "NChp", mais rien n'y fait, je ne dois pas m'y prendre correctement.

Le but étant de pouvoir rajouter une dizaine de colonnes (Adresse + Mail + ...) au tableau sur la Feuille "Base".

Merci pour votre aide.
 

Pièces jointes

  • Fiche instument.xls
    110.5 KB · Affichages: 10
C

Compte Supprimé 979

Guest
Bonjour Yanou38

Qui t'as construit cette formule pour définir ta plage de données 😱
VB:
=DECALER(Base!$B$2;;;MAX((DECALER(Base!$B$2;;;NEnr;1)<>"")*LIGNE(DECALER(Base!$2:$2;;;NEnr;)));MAX((DECALER(Base!$B$2;;;;NChp)<>"")*COLONNE(DECALER(Base!$B:$B;;;;NChp))))

Sinon à part être sur une très vieille version d'Excel, pourquoi ne pas utiliser un tableau structuré ?

A+
 

YANOU38

XLDnaute Occasionnel
Bonjour BrunoM45, le Forum,
J'ai récupéré ce code sur Excel Downloads, il marchait très bien avant que je décide d'y mettre les pattes. ;)
Je ne connaissais pas les Tableaux structurés (je viens d'aller y jeter un coup d'oeil).
Si je n'ai pas d'autres réponses, je tenterai d'utiliser cette solution.
Merci pour votre aide.
 
C

Compte Supprimé 979

Guest
Re,

Voici le fichier au format ".xlsm", le code modifié et avec un tableau structuré ;)

A toi de voir

Nota : Si l'envie te prenait, je ne teste pas le nombre de ligne vide. Un TS ce doit d'être sans, cela ne sert à rien.

A+
 

Pièces jointes

  • Yanou38_Fiche instument.xlsm
    44.2 KB · Affichages: 19
C

Compte Supprimé 979

Guest
Re,

Pour les futures colonnes, il suffit de les ajouter au code dans le ARRAY()

Avant la dernière parenthèse fermante, ajouter une virgule + espace + tiret bas
et à la ligne on ajoute
VB:
Array("Réglé le", "Réglé le :", "B11"))
sans oublier la dernière parenthèse fermante

Ensuite, le code est fait en sorte que tout est auto

J'espère que ce sera clair pour toi 🤔

A+
 
C

Compte Supprimé 979

Guest
Re,

C'est la colonne "Tarif à l'année" qui pose problème effectivement et c'est une cellule qu'on ne remplit pas à priori dans le modèle 🤔

Il faut soit la sauter, soit mettre une cellule fictive

A+
 
C

Compte Supprimé 979

Guest
Re,

Pour mieux que tu comprennes mon idée, voici le code auquel je pensais

Tu verras que "Tarif à l'année " fait référence à une cellule extérieures à ton masque J12

VB:
Sub Toto()
  Dim i&, j&, ind$, tmp$, Chp(), oSh(), oKeys(), oItms(), oDt As Scripting.Dictionary
  Dim LObj As ListObject
  'correspondance des champs des feuilles "base" et "Modele", DANS L'ORDRE DES CHAMPS DE "base".
  Chp = Array( _
        Array("NOM", "Nom : ", "B4"), _
        Array("Prénom", "Prénom : ", "B5"), _
        Array("Propriété", "Propriété : ", "B6"), _
        Array("Instrument", "Instrument : ", "B7"), _
        Array("Marque", "Marque :", "B8"), _
        Array("Type", "Type :", "B9"), _
        Array("N°", "N° :", "B10"), _
        Array("Choix option", "Choix option :", "B11"), _
        Array("Tarif à l'année", "Tarif à l'année : ", "J12"), _
        Array("Réglé le", "Réglé le :", "B12"))
  ' Définition du tableau structuré
  Set LObj = Sheets("Base").ListObjects("Tableau1")
  ' Vérifier si des lignes existes
  If LObj.ListRows.Count = 1 Then Exit Sub       'Rien à traiter
  ' Vérifier l'ordre des champs
  For i = 0 To UBound(Chp)
    If Chp(i)(0) <> LObj.HeaderRowRange.Cells(1, 1 + i) Then MsgBox ("Base inadéquate"): Exit Sub 'Base inadéquate.
  Next
  'Ventilation de la base par onglet :
  Set oDt = CreateObject("Scripting.Dictionary")
  For i = 1 To LObj.ListRows.Count               ' De la première ligne de données à la dernière
    With LObj.DataBodyRange
      ind = .Cells(i, 1) & "_" & .Cells(i, 2)
      tmp = ""
      Do While oDt.Exists(ind & tmp): tmp = " " & CStr(Val(tmp) + 1): Loop 'Gestion des homonymies.
      oDt.Add ind & tmp, Array(ind & tmp, .Rows(i).Value)
    End With
  Next
  'Répertoire des feuilles existantes :
  ReDim oSh(1 To Sheets.Count)
  For i = 1 To Sheets.Count: oSh(i) = Sheets(i).Name: Next
  '
  'création/mise à jour des onglets :
  oKeys = oDt.Keys
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For i = 0 To oDt.Count - 1
    For j = 1 To UBound(oSh)
      If oKeys(i) = oSh(j) Then Exit For
    Next j
    If j > UBound(oSh) Then                      'Nouvelle feuille
      Worksheets("Modele").Copy Before:=Worksheets("Modele")
      ActiveSheet.Name = oKeys(i)
    Else                                         'Feuille existante
      Worksheets(oKeys(i)).Activate
    End If
    oItms = oDt(oKeys(i))(1)
    For j = 0 To UBound(Chp): ActiveSheet.Range(Chp(j)(2)) = oItms(1, j + 1): Next
    Call Masque
  Next i
  Sheets("Base").Activate
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
  Set oDt = Nothing: Erase Chp(), oSh(), oKeys(), oItms()
End Sub

A+
 
C

Compte Supprimé 979

Guest
Re,

Sérieux Yanou38 🤨 :rolleyes:

Ce message s'arrête à quel endroit et quelle ligne est surlignée !?

1636372895707.png


Dans votre fichier d'origine, vous avez une Sub Masque() qu'il ne faut pas supprimer, à moins qu'elle ne vous serve à rien !?
Auquel cas il faut également supprimer la ligne en question
 

Discussions similaires

Réponses
1
Affichages
250
Compte Supprimé 979
C
Réponses
0
Affichages
194

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla