Discussion :

[batmat86]

Bonjour à vous,

je me permet de vous demander un peu d'aide car mes tentatives n'ont pas été fructueuse.

Voici mon code actuel que j'ai sur le clic d'un bouton.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub SauvegarderFicheVierge_Click()
Dim FichB As String, FichC As String, NomFichier As String, Prefixe As String
Dim Wbk As Workbook
 
 
Application.ScreenUpdating = False
FichB = ThisWorkbook.Path & "\fiche_Manuelle_vierge.xlsx"
Set Wbk = Workbooks.Open(FichB)
ThisWorkbook.Sheets("Vierge").Range("A1:H33").Copy
'On colle les valeurs, format et largeurs des colonnes
With Wbk.Worksheets("Fiche").Range("A1:H33")
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
 
'nom du fichierC à génerer TotoXXX.xlsx (avec XXX valeur de A1 de feuille Fiche du classeur B
NomFichier = "Fiche Manuelle_" & Wbk.Sheets("Fiche").Range("C27").Value & " " & Wbk.Sheets("Fiche").Range("G27").Value
Bureau = Environ("userprofile") & "\desktop"
FichC = Bureau & "\" & NomFichier
'FichC = ThisWorkbook.Path & "\" & NomFichier
Application.DisplayAlerts = False
Wbk.SaveAs FichC, xlOpenXMLWorkbook
Application.DisplayAlerts = True
Wbk.Close
Set Wbk = Nothing
'Message pour informer que fichier bien enregistré
MsgBox "Votre fiche décès est bien enregistrée sur le Bureau sous le nom : " & NomFichier
 
End Sub

Cela fonctionne sans souci, mais avec le temps, cela n'est plus très viable car j'ai multiplié les onglets avec ce même bouton, donc actuellement j'ai des tonnes de fichiers vierges qui doivent être associé à mon fichier excel.

J'ai donc remplacer mon code, afin que celui-ci, plutôt que d'aller chercher un fichier vierge avec le nom associé, puisse créer un nouveau fichier et coller les données dans celui-ci après création et l'enregistrer avec les mêmes paramètres qu'actuellement.

je pense que cela doit être assez simple pour des personnes qui maîtrisent excel et le VBA, mais pour ma part, je n'arrive pas à faire cette modification Soit la création du fichier se passe mal, soit le coller dedans ou autre.

Merci par avance de votre aide, cordialement

[batmat86]

Bonjour à vous,

A force de chercher et faire des tests, j'avance un peu, mais je n'arrive pas encore au résultat souhaité.

Voici mon nouveau code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub SauvegarderFiche_Click()
 
Dim newWbk As Workbook, feuilCal As Worksheet, pathBureau As String, nomNewClasseur As String
 
    'définir le chemin du Bureau
    pathBureau = Environ("userprofile") & "\desktop"
 
    'définir la feuille à copier
    Set feuilCal = ThisWorkbook.Sheets("Export")
 
    'créer un nouveau classeur avec une seule feuille
    Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)
 
    'copier les cellules de la feuille "Export"
    'feuilCal.Cells.Copy
    ThisWorkbook.Sheets("Export").Range("A1:H50").Copy
 
    'coller les valeurs dans le nouveau classeur, puis les formats, puis les largeurs de colonnes
    newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
    newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
    Application.CutCopyMode = False
 
    'récupérer le nom à donner au nouveau classeur
    nomNewClasseur = "Fiche Test_" & newWbk.Sheets("Feuil1").Range("C27").Value & " " & newWbk.Sheets("Feuil1").Range("G27").Value
 
    'sauvegarder le classeur et le fermer
    newWbk.SaveAs pathBureau & "\" & nomNewClasseur & ".xlsx"
    newWbk.Close
    'Message pour informer que fichier bien enregistré
    MsgBox "Votre fiche est bien enregistrée sur le Bureau sous le nom : " & nomNewClasseur
 
 
 
End Sub

Cela fonctionne pour les données, et la création du fichier.

Mon souci restant concerne la mise en page qui n'est pas sauvegardé, ainsi ma feuille source à des marges personnalisé afin qu'à l'impression cela loge sur une seule page et malheureusement au coller cela n'est pas pris en compte.

Et deuxième problème j'ai sur ma feuille source une image dans la zone F2:G3, mais celle-ci n'est pas prise lors du copier coller.

Par conséquent, est il possible de copier également l'image qui est bien dans la zone du copier en source afin de la coller sur la feuille de destination avec le reste ? Et est il possible de transposer aussi la mise en page de la feuille ?

Merci par avance de votre aide précieuse, cordialement.

[Qwazerty]

Salut

Essaie en remplaçant les deux premiers PasteSpecial par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ThisWorkbook.Sheets("Export").Range("A1:H50").Copy newWbk.Sheets(1).Range("A1")

Ce code copie les données et le format (Couleur, cadre, ...), il reste juste à faire le pastspecial pour les largeurs de colonne.

++
Qwaz

[batmat86]

Bonsoir,

Merci à toi de l'aide, donc si je résume bien cela me fait le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub SauvegarderFiche_Click()
 
Dim newWbk As Workbook, feuilCal As Worksheet, pathBureau As String, nomNewClasseur As String
 
    'définir le chemin du Bureau
    pathBureau = Environ("userprofile") & "\desktop"
 
    'définir la feuille à copier
    Set feuilCal = ThisWorkbook.Sheets("Export")
 
    'créer un nouveau classeur avec une seule feuille
    Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)
 
    'Copier/coller les valeurs dans le nouveau classeur, puis les largeurs de colonnes
    ThisWorkbook.Sheets("Export").Range("A1:H50").Copy newWbk.Sheets(1).Range("A1")
    ThisWorkbook.Sheets("Export").Range("A1:H50").Copy
    newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
    Application.CutCopyMode = False
 
    'Définir les marges
    SetMargins ActiveSheet, 1.1, 1.1, 1.9, 0
 
    'récupérer le nom à donner au nouveau classeur
    nomNewClasseur = "Fiche Test_" & newWbk.Sheets("Feuil1").Range("C27").Value & " " & newWbk.Sheets("Feuil1").Range("G27").Value
 
    'sauvegarder le classeur et le fermer
    newWbk.SaveAs pathBureau & "\" & nomNewClasseur & ".xlsx"
    newWbk.Close
    'Message pour informer que fichier bien enregistré
    MsgBox "Votre fiche est bien enregistrée sur le Bureau sous le nom : " & nomNewClasseur
 
 
 
End Sub

Et j'ai pu aussi trouvé pour les marges dont j'ai fait le paramètres au dessus manuellement dans le code ci dessus, n'ayant pas trouvé comment mettre en centrage vertical et horizontal.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Sub SetMargins(oWS As Excel.Worksheet, nLeft As Double, nRight As Double, nTop As Double, nBottom As Double)
    With oWS.PageSetup
        .LeftMargin = oWS.Application.CentimetersToPoints(nLeft)
        .RightMargin = oWS.Application.CentimetersToPoints(nRight)
        .TopMargin = oWS.Application.CentimetersToPoints(nTop)
        .BottomMargin = oWS.Application.CentimetersToPoints(nBottom)
    End With
End Sub

Cela fonctionne bien, l'image et bien copier et coller, les marges se font bien, par contre je ne comprends pas que mon fichier de destination à l'impression contient 2 pages et non une seule comme la source, et la 2eme page est entièrement vide et je ne vois pas pourquoi, une idée ?

[Qwazerty]

Salut

Une question avant d'aller plus loin, pourquoi ne pas copier l'intégralité de la feuille, comme si tu faisais un clique droit sur ton onglet puis copier dans un nouveau classeur? Quitte si besoin à supprimer des cellules inutiles, au moins comme ça tu aurais l'intégralité de tes données, la mise en page et tout et tout.

Pour le nombre de page c'est probablement la zone d'impression qui ne va pas.
Dans ton nouveau classeur active la vue "Aperçu des sauts de page" dans l'onglet "Affichage" et regarde si ton problème de page vierge ne vient pas d'un saut de page mal placé. Si c'est le cas il faudrait sans doute régler comme il faut via ta macro les valeur contenue dans l'onglet " Mise en page", groupe "Mise à l’échelle". Il faut faire des teste sur ton fichier nouvellement créé en modifiant les valeur jusqu'à obtenir ce que tu veux. Puis tu enregistres une macro pour trouver le code correspondant et tu l'incorpores dans ton code.

++
Qwaz

[batmat86]

Une question avant d'aller plus loin, pourquoi ne pas copier l'intégralité de la feuille, comme si tu faisais un clique droit sur ton onglet puis copier dans un nouveau classeur? Quitte si besoin à supprimer des cellules inutiles, au moins comme ça tu aurais l'intégralité de tes données, la mise en page et tout et tout.

J'avoue que j'y avais pensé, mais cela me semblait plus complexe, avec la suppression des 2 boutons à faire, car j'en ai un qui permet d'actualiser mon fichier source et un autre pour faire l'export dans un autre fichier.
Mais peut être en effet que j'ai pris le plus complexe ....

Pour l'histoire de la mise en page sur 2 pages, apparemment cela venait du fait que l'image devait dépasser de la colonne H d'un micromillimètre ... En la décalant légèrement plus de souci ....

Merci beaucoup de l'aide, vraiment pas simple excel quand on rentre dans le VBA ...