Copier coller de Tableau + mise en page + Création d'un pdf
Bonjour,
Je poste aujourd'hui car je suis a la recherche d'une macro qui dans un premier temps me permettrait de copier une partie d'un tableau structuré dans le Classeur1 qui a pour nom (Stock2022VBA) pour le coller dans un Classeur2 (StockTemp).
Ensuite j'edite a la main les options de mes clients dans le nouveau Classeur2 et dans un second temps la macro devrait pouvoir renvoyer les options dans le tableau original grâce a un bouton ou quelque chose du genre.
Et enfin 3eme temps, aprés avoir renvoyé les infos ils faudrait pouvoir ajouter des pages du modèle (ModèleDossierVBA) au classeur 2 selon les options qui on été choisie par le client (Exp : Si le client a l'option Bovins lait, il faut ajouter la page de facture "Bovins lait" etc)
J'ai déjà établi une partie du code je suis preneur de toutes correction/aide ou solution
En détails, voila le fonctionnement :
1- Saisie texte pour sélectionnez les dossiers des comptables à traiter (Recherche par saisie du "Code.Collab", toutes les lignes d'information lié au code collab appelé devront être extraites lors de l'opération) Si code collab 2 est appelé il faudrait tout les dossiers lié au code collab 2 etc.
2- Extraction des « dossiers » du document vers un nouveau Classeur Excel (Qui sera nommé : StockTemp)
3- ? Quelles sont les options du client ? Exp: Bovin lait ou viande etc
4- Retour des informations « D’options client » dans le document original (Nommé : Stock2022VBA.xlsx)
5- Génère une copie temporaire du document « ModeleDossierVBA.xlsx»
6- Suppression des pages inutiles (Suppression de toutes les pages "modèles" de facture inutile)
7- Création du pdf depuis le fichier temporaire
8- Suppression du fichier temporaire"
(J'utilise un UserForm dans Sub main pour l'Interface utilisateur)
Sub main()
Dim reponse As String
reponse = InputBox("Quels dossiers de collaborateur cherchez vous ? (Veuillez entrer le CodeCollab a extraite)", "Extraction Dossier Client")
If reponse = "" Then
Call MsgBox("Je n'ai pas compris votre demande veuillez reessayer", , "Erreur")
Else
Call MsgBox("Vous avez demande les dossiers du code collab " & reponse & "", , "Dossier à extraire")
RechercheDossiersCollab
End If
End Sub
Sub RechercheDossiersCollab()
Const Limit As Integer
For Each c In Range("Code_Collab")
If c.Value = Limit Then
ExportCollab
End If
Next c
End Sub
Sub ExportCollab()
//A Faire//
End Sub
Merci a vous pour l'aide
Cordialement,
Ao.
Bonjour aoplis,
1) dans les fichiers donnés, aucun avec un USF ou du code (pas de .xlsm)
2) Vous pouvez utiliser l'enregistreur de macros pour avoir votre code
Après avoir cliqué sur ce bouton, effectuez les opérations indiquées et vous obtiendrez du code
Que nous pourrons alors optimiser, si vous le souhaitez
a+
Bonjour Bruno,
Merci pour ta réponse.ça parait peu être bête mais je pensais honnêtement que l'enregistreur de macro était catastrophique comme beaucoup d'autre outils du même genre.
Je me suis mis au travail et voila ce que j'ai actuellement :
1-La boite de dialogue fonctionne
2-La fonction d'extraction tourne a merveille
3-Il me manque le retour des informations saisie depuis le nouveau fichier vers le fichier d'origine. Y a t'il une solution pour l’échange d'information entre deux excel ? Sachent que mon document original fait environ 3000lignes sur 26colonne et que j'ai besoin de saisir les information seulement depuis le morceau de document extrait + Toutes les informations sont contenue dans un tableau nommé CONSOLIDATION qui ce divise en différentes partie en utilisant le CodeCollab.
4-La moitié du tableau est déjà complété, il manque seulement les données des 16 dernières colonnes, ce sont les informations a faire remonter dans le fichier original
5-Ainsi que la création des pdf qui en découle. (Qui ne sera pas trop dur a faire)
Au plaisir de vous lire, Ao.
Rebonjour,
J'ai quasiment fini la partie export en pdf du modèle de facture.
Mon seul problème est que quand j'essaye de faire remonter une info d'un tableau avec un filtre appliqué je me retrouve avec des données qui aurait du être filtré voila le code :
Et je me retrouve en sortie avec un firchier qui s'enregistre au nom de "2022_" au lieu d'inclure le nom du client.
J'ai tester de remplacer
NomClient = Range("F2")
Par
NomClient = ActiveSheet.ListObjects("CONSOLIDATION").ListColumns("Nom_Client").DataBodyRangeIl me faudrait pour tout dire, aprés avoir appliqué le filtre, sélectionner les données filtrés pour les exploiter Public NumDossier As String
Sub ChatBoxNumDossier()
NumDossier = InputBox("Quels dossiers cherchez vous ? (Veuillez entrer le numero de dossiers a extraite)", "Extraction Dossier Client")
If NumDossier = "" Then
Call MsgBox("Je n'ai pas compris votre demande veuillez reessayer", , "Erreur")
Else
Call MsgBox("Vous avez demande le dossier numero " & NumDossier & "", , "Dossier à extraire")
CreationModelePdf
End If
End Sub
Sub CreationModelePdf()
Dim CheminModele As String
CheminModele = "\\SRV\ModelePDF.xlsx"
ActiveSheet.ListObjects("CONSOLIDATION").Range.AutoFilter Field:=2, Criteria1:=NumDossier
NomClient = Range("F2")
DateCloture = Range("G2")
BovinsViande = Range("H2")
BovinsLait = Range("I2")
Workbooks.Open Filename:=CheminModele
Range("D9:G9").Select
ActiveCell.FormulaR1C1 = NomClient
Range("D12:G12").Select
ActiveCell.FormulaR1C1 = NumDossier
Range("G22:H22").Select
ActiveCell.FormulaR1C1 = DateCloture
Application.DisplayAlerts = False
If BovinsViande = "" Then
Sheets("Bovins Viandes").Select
ActiveWindow.SelectedSheets.Delete
Else
End If
If BovinsLait = "" Then
Sheets("Bovins lait").Select
ActiveWindow.SelectedSheets.Delete
Else
End If
Application.DisplayAlerts = True
SavePDF
End Sub
Sub SavePDF()
myPath = "\\SRV\"
Filename = Year(Date) & "_" & NomClient
Sheets.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPath & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End SubMerci a vous pour l'aide
Ao