Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Bonjour à tous!
j'ai un fichier pour traiter mes factures fournisseurs.
Afin de pouvoir réaliser mon TB, j'ai besoin d'une feuille que j'ai appelée "Synthèse" qui regroupe toutes les factures saisies. J'ai donc modifié le code bouton "Ajouter" du formulaire "Saisir facture" afin d'obtenir les factures saisies.
Le petit bémol est que les données sont bien copiées dans la feuille "Synthèse" mais sans le nom de la feuille qui lui corresponde.
Quelqu'un pourrait-il m'aider à trouver ce qui manque à mon code stp.
Merci
Pour la première erreur, as-tu créé le tableau structuré "tb_Synthèse" ?
Place toi sur une ligne de la zone de résultat, onglet Accueil, Mettre sous forme de tableau, choisis un style à ta convenance, vérifie la zone présélectionnée, coche Mon tableau comporte des en-têtes, change le nom du tableau (ici tableau4 par tb_Synthèse) :
Pour la seconde : c'est de ma faute, j'avais commencé une modification que je n'ai pas annulée
Dans la pièce jointe j'ai modifié le code de ce CommandButton "CmdAjout" pour inclure ma macro.
Voir la pièce jointe (n'oublie pas de modifier le codename de la feuille de synthèse en...
Private Sub CmdAjout_Click()
Dim feuille As Worksheet
Dim plagecopiee As Range
Dim nouvelleligne As Range
Dim recap As Worksheet
Application.ScreenUpdating = False
Set nouvelleligne = Feuil19.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Feuil19.Range("A6:I100000").ClearContents
For Each feuille In Worksheets
Set plagecopiee = feuille.Range("A25:g100000")
Select Case feuille.CodeName
Case "Feuil19", "Feuil18", "Feuil17", "Feuil16", "Feuil2"
Case Else
plagecopiee.Copy
nouvelleligne.PasteSpecial xlPasteValues
End Select
Set nouvelleligne = Feuil19.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Next feuille
Set recap = Feuil19
recap.Range("B6:i1000000").Sort key1:=recap.Range("B6"), Header:=xlYes
AjoutFacture sfeuille
On Error Resume Next
End Sub
Private Sub CmdAjout_Click()
Dim feuille As Worksheet
Dim plagecopiee As Range
Dim nouvelleligne As Range
Dim recap As Worksheet
Application.ScreenUpdating = False
Set nouvelleligne = Feuil19.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Feuil19.Range("A6:I100000").ClearContents
For Each feuille In Worksheets
Set plagecopiee = feuille.Range("A25:g100000")
Select Case feuille.CodeName
Case "Feuil19", "Feuil18", "Feuil17", "Feuil16", "Feuil2"
Case Else
plagecopiee.Copy
nouvelleligne.PasteSpecial xlPasteValues
End Select
Set nouvelleligne = Feuil19.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Next feuille
Set recap = Feuil19
recap.Range("B6:i1000000").Sort key1:=recap.Range("B6"), Header:=xlYes
AjoutFacture sfeuille
On Error Resume Next
End Sub
Lorsqu'on est sur la feuille "Synthèse", il y a l'entête qui figure à partir de la ligne 4.
devant chaque ligne à compter de la ligne 5, en A5 et suivant, le nom de la feuille qui correspond au nom du fournisseur d'où les données ont été copiées, doit figurer.
je ne sais pas si je me fais bien comprendre
Lorsqu'on est sur la feuille "Synthèse", il y a l'entête qui figure à partir de la ligne 4.
devant chaque ligne à compter de la ligne 5, en A5 et suivant, le nom de la feuille qui correspond au nom du fournisseur d'où les données ont été copiées, doit figurer.
je ne sais pas si je me fais bien comprendre
En regardant ton formulaire "FrmSaisieFacture" je constate que tu mets à jour la totalité du tableau de synthèse à chaque ajout d'une nouvelle facture ... Est-ce bien nécessaire ?
Quoi qu'il en soit j'ai créé, dans le module "mdl_AtTheOne", une macro "Remplir_tb_Synthèse" qui fait ce travail et que tu n'auras qu'à appeler au moment qui te sembles opportun.
J'ai préalablement transformé la zone de résultat de la Synthèse en un tableau structuré que j'ai nommé "tb_Synthèse"
Les essais que j'ai fait m'ont révélé des incohérences dans le type de données recueillies :
Quelques dates sous forme de text, quelques montants également sous forme de texte (incluant le suffixe CFA). J'ai corrigé cela dans la pièce jointe.
Module "mdl_AtTheOne"
Enrichi (BBcode):
Sub Remplir_tb_Synthèse()
Dim NbLgn As Long, i As Long, j As Byte, lgn As Long, tb, TbRes()
Dim LO As ListObject, Sh_Synthèse As Worksheet, feuille As Worksheet
Dim Dc As Object, Clef
Set Dc = CreateObject("Scripting.Dictionary")
Dc.RemoveAll
'Dictionnaire clef=NomDeFeuille, article=Données du tableau structuré
NbLgn = 0
'Initialisation du nombre de lignes récupérées à 0
Set Sh_Synthèse = Feuil19
Sh_Synthèse.Evaluate(Sh_Synthèse.ListObjects(1).Name).ClearContents
'Vider la plage de données du tableau structuré "tb_Synthèse"
Set LO = Sh_Synthèse.ListObjects("Tb_Synthèse")
For Each feuille In ThisWorkbook.Worksheets
'Boucle sur toutes les feuilles du classeur
Select Case feuille.CodeName
Case "Feuil19", "Feuil18", "Feuil17", "Feuil16", "Feuil2"
'Exclusion des feuilles autres que les feuilles contenant les factures à honorer
Case Else
Dc(feuille.Name) = feuille.Evaluate(feuille.ListObjects(1).Name).Value2
'Récupération dans l'entrée "Feuille.name" du dictionnaire des données du tableau structuré
NbLgn = NbLgn + UBound(Dc(feuille.Name))
'Incrémentation du nombre de lignes récupérées
End Select
Next
If Dc.Count > 0 Then
'Si l'on a récupéré des données
ReDim TbRés(1 To NbLgn, 1 To 8)
'Dimensionnement d'un tableau résultat pour récupérer toutes les données collectées
i = 1
For Each Clef In Dc.Keys
'Pour chaque nom de feuille d'où l'on a récupéré des données
tb = Dc(Clef)
'On charge les données dans le tableau tb
For lgn = 1 To UBound(tb)
'Pour chaque ligne du tableau tb
TbRés(i, 1) = Clef
'On met en colonne 1 le nom de la feuille concernée
For j = 1 To 7
TbRés(i, j + 1) = tb(lgn, j)
'On charge les autres données de la ligne
Next j
i = i + 1
'on incrémente le N° de ligne du tableau résultat
Next lgn
Next Clef
End If
LO.Resize LO.HeaderRowRange.Resize(NbLgn + 1)
'On redimensionne le tableau structuré cible
Sh_Synthèse.[Tb_Synthèse].Value2 = TbRés
'On charge en 1 seule fois toutes les données du tableau cible
End Sub
J'ai placé un bouton sur la feuille "Synthèse" pour appeler la macro
Bon courage,
STP fais moi un retour
Amicalement
Alain
Re
a la vue de ton travail, je te propose c'est deux petits codes pour remplacer le tien
Ils utilises les tableaux.
Si j'ai bien vu, tu ajoute la nouvelle facture qu"après??? est-ce bien normal
Sub ajoutesynthèse()
Feuil19.Range("A5:I100000").ClearContents
For Each f In Sheets
Select Case f.CodeName
Case "Feuil19", "Feuil18", "Feuil17", "Feuil16", "Feuil2"
Case Else
Call copietableau(f)
End Select
Next
End Sub
Sub copietableau(f)
With Sheets("Synthèse")
drlg = .Cells(.UsedRange.Count + 1, 1).End(xlUp).Row + 1
Set zone = f.ListObjects(1).DataBodyRange
zone.Copy
.Cells(drlg, 2).PasteSpecial (xlValues)
.Range(.Cells(drlg, 1), .Cells(drlg - 1 + zone.Rows.Count, 1)) = f.Name
En regardant ton formulaire "FrmSaisieFacture" je constate que tu mets à jour la totalité du tableau de synthèse à chaque ajout d'une nouvelle facture ... Est-ce bien nécessaire ?
Quoi qu'il en soit j'ai créé, dans le module "mdl_AtTheOne", une macro "Remplir_tb_Synthèse" qui fait ce travail et que tu n'auras qu'à appeler au moment qui te sembles opportun.
J'ai préalablement transformé la zone de résultat de la Synthèse en un tableau structuré que j'ai nommé "tb_Synthèse"
Les essais que j'ai fait m'ont révélé des incohérences dans le type de données recueillies :
Quelques dates sous forme de text, quelques montants également sous forme de texte (incluant le suffixe CFA). J'ai corrigé cela dans la pièce jointe.
Module "mdl_AtTheOne"
Enrichi (BBcode):
Sub Remplir_tb_Synthèse()
Dim NbLgn As Long, i As Long, j As Byte, lgn As Long, tb, TbRes()
Dim LO As ListObject, Sh_Synthèse As Worksheet, feuille As Worksheet
Dim Dc As Object, Clef
Set Dc = CreateObject("Scripting.Dictionary")
Dc.RemoveAll
'Dictionnaire clef=NomDeFeuille, article=Données du tableau structuré
NbLgn = 0
'Initialisation du nombre de lignes récupérées à 0
Set Sh_Synthèse = Feuil19
Sh_Synthèse.Evaluate(Sh_Synthèse.ListObjects(1).Name).ClearContents
'Vider la plage de données du tableau structuré "tb_Synthèse"
Set LO = Sh_Synthèse.ListObjects("Tb_Synthèse")
For Each feuille In ThisWorkbook.Worksheets
'Boucle sur toutes les feuilles du classeur
Select Case feuille.CodeName
Case "Feuil19", "Feuil18", "Feuil17", "Feuil16", "Feuil2"
'Exclusion des feuilles autres que les feuilles contenant les factures à honorer
Case Else
Dc(feuille.Name) = feuille.Evaluate(feuille.ListObjects(1).Name).Value2
'Récupération dans l'entrée "Feuille.name" du dictionnaire des données du tableau structuré
NbLgn = NbLgn + UBound(Dc(feuille.Name))
'Incrémentation du nombre de lignes récupérées
End Select
Next
If Dc.Count > 0 Then
'Si l'on a récupéré des données
ReDim TbRés(1 To NbLgn, 1 To 8)
'Dimensionnement d'un tableau résultat pour récupérer toutes les données collectées
i = 1
For Each Clef In Dc.Keys
'Pour chaque nom de feuille d'où l'on a récupéré des données
tb = Dc(Clef)
'On charge les données dans le tableau tb
For lgn = 1 To UBound(tb)
'Pour chaque ligne du tableau tb
TbRés(i, 1) = Clef
'On met en colonne 1 le nom de la feuille concernée
For j = 1 To 7
TbRés(i, j + 1) = tb(lgn, j)
'On charge les autres données de la ligne
Next j
i = i + 1
'on incrémente le N° de ligne du tableau résultat
Next lgn
Next Clef
End If
LO.Resize LO.HeaderRowRange.Resize(NbLgn + 1)
'On redimensionne le tableau structuré cible
Sh_Synthèse.[Tb_Synthèse].Value2 = TbRés
'On charge en 1 seule fois toutes les données du tableau cible
End Sub
J'ai placé un bouton sur la feuille "Synthèse" pour appeler la macro
Bon courage,
STP fais moi un retour
Amicalement
Alain
Pour la première erreur, as-tu créé le tableau structuré "tb_Synthèse" ?
Place toi sur une ligne de la zone de résultat, onglet Accueil, Mettre sous forme de tableau, choisis un style à ta convenance, vérifie la zone présélectionnée, coche Mon tableau comporte des en-têtes, change le nom du tableau (ici tableau4 par tb_Synthèse) :
Pour la seconde : c'est de ma faute, j'avais commencé une modification que je n'ai pas annulée
Dans la pièce jointe j'ai modifié le code de ce CommandButton "CmdAjout" pour inclure ma macro.
Voir la pièce jointe (n'oublie pas de modifier le codename de la feuille de synthèse en PJ c'est toujours "feuil19" Y compris dans le Select Case de la macro)
Enrichi (BBcode):
Private Sub CmdAjout_Click()
Application.ScreenUpdating = False
AjoutFacture sfeuille
Remplir_tb_Synthèse
Application.ScreenUpdating = True
End Sub
Pour la première erreur, as-tu créé le tableau structuré "tb_Synthèse" ?
Place toi sur une ligne de la zone de résultat, onglet Accueil, Mettre sous forme de tableau, choisis un style à ta convenance, vérifie la zone présélectionnée, coche Mon tableau comporte des en-têtes, change le nom du tableau (ici tableau4 par tb_Synthèse) :
Pour la seconde : c'est de ma faute, j'avais commencé une modification que je n'ai pas annulé
Dans la pièce jointe j'ai modifié le code de ce CommandButton "CmdAjout" pour inclure ma macro.
Voir la pièce jointe (n'oublie pas de modifier le codename de la feuille de synthèse en PJ c'est toujours "feuil19" Y compris dans le Select Case de la macro)
Enrichi (BBcode):
Private Sub CmdAjout_Click()
Application.ScreenUpdating = False
AjoutFacture sfeuille
Remplir_tb_Synthèse
Application.ScreenUpdating = True
End Sub
