Modification code VBA, ouvrir un fichier existant, par une création de fichier

Version imprimable

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:

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

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:

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.

30/04/2018, 20h37
Qwazerty

Salut

Essaie en remplaçant les deux premiers PasteSpecial par

Code:

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

Bonsoir,

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

Code:

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:

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 ?

30/04/2018, 21h40
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
30/04/2018, 21h54
batmat86

Citation:

Envoyé par Qwazerty

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 ...

Hum, bien plus simple à mon avis :)

Un bon réflexe est d'enregistrer un macro, ça permet rapidement d'avoir les bases de la "grammaire" du futur code à produire.

Dans ton cas, produit par l'enregistreur de macro
Code:

1 2 3 4 5 6 7 Sheets("Feuil2").Select ActiveSheet.Buttons.Add(498.75, 210.75, 80.25, 69).Select Sheets("Feuil2").Copy ActiveSheet.Shapes("CommandButton1").Select Selection.Delete ActiveSheet.Shapes("Button 1").Select Selection.Delete
Deuxième bon réflexe, la touche F1 sur, par exemple, "Copy" et qui va te dire

Citation:

Envoyé par Aide Excel VBA

Si vous ne spécifiez ni l'argument Avant ni l'argument Après, Microsoft Excel crée un nouveau classeur contenant la feuille copiée.

Les Shapes représentent un peut tous les objets présents sur ta page.
Tu n'as plus qu'à retravailler un peu le code pour supprimer les ActiveSheet, Selection. Supprimer les lignes inutiles et le tour est joué ;)

++
Qwaz

Et bien dis dont, beaucoup d'informations ce soir et de choses nouvelles ....

l'enregistreur de macro, je n'en avais jamais entendu parlé et ne connaissais pas ....

J'ai donc trouvé plein de choses à étudier ici ^^

https://fauconnier.developpez.com/tu...istreur-macro/

Ce qui me donne le code suivant en faisant manuellement ce que je souhaite faire, enfin sans la partie enregistrer sous du fichier où est dupliquer l'onglet ...
Code:

1 2 3 4 5 6 7 Sheets("Export").Select Sheets("Export").Copy ActiveSheet.Shapes.Range(Array("MAJ")).Select Selection.Delete ActiveSheet.Shapes.Range(Array("sauvegarderfiche")).Select Selection.Delete Windows("Matrice_fiches_Test.xlsm").Activate
Donc oui une très bonne piste je pense que tu m'as donné donc merci beaucoup de ton aide, plus qu'à tout bien lire le lien que j'ai cité et suivre tes conseils dans les jours à venir et je vais peut être pouvoir trouver la solution ;)

En tout cas, je ne manquerai pas de vous tenir informé du résultat, que j'y arrive ou que je bloque ;)

Bonne soirée, après plusieurs heures à tenter d'avancer, je pense qu'il est temps d'aller dormir un peu avant d'approfondir plus toutes ces nouvelles informations

Bonjour, et bien après une bonne nuit de sommeil, cela est plus simple d'intégrer les pistes que tu m'as donné ;)

Et en effet, je pense que ma solution qui semblait la plus simple, était la plus complexe ^^

En suivant tes conseils, j'ai réussi à faire ce que je souhaitais avec ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 'définir le chemin du Bureau pathBureau = Environ("userprofile") & "\desktop" 'créer un nouveau classeur avec une seule feuille Sheets("Export").Select Sheets("Export").Copy ActiveSheet.Shapes("MAJ").Select Selection.Delete ActiveSheet.Shapes("SauvegarderFiche").Select Selection.Delete nomNewClasseur = "Fiche_" & ActiveWorkbook.Sheets("Export").Range("C23").Value & " " & ActiveWorkbook.Sheets("Export").Range("G23").Value ActiveWorkbook.SaveAs pathBureau & "\" & nomNewClasseur & ".xlsx" ActiveWorkbook.Close 'Message pour informer que fichier bien enregistré MsgBox "Votre fiche est bien enregistrée sur le Bureau sous le nom : " & nomNewClasseur
Tout fonctionne correctement, faut juste que j'arrive à ajouter le choix en automatique pour la fenêtre qui apparaît me demandant si oui ou non je veux bien enregistrer le fichier et perdre les macros. Si cela peut faire un clic en moins pour l'utilisateur ... Pour le moment pas encore trouvé, mais en cours de recherche.

Edit : Autre petit souci, si je modifie ma déclaration de variable qui était :

Code:

Dim newWbk As Workbook, feuilCal As Worksheet, pathBureau As String, nomNewClasseur As String

Par :

Code:

pathBureau As String, nomNewClasseur As String

Vu que les 2 premières variables ne sont plus utilisées, autant supprimer leur déclaration, mais du coup j'obtiens une erreur de compilation avec instruction incorrecte à l'intérieur d'un bloc de type :(

01/05/2018, 11h06
Qwazerty
Salut

Essai en encadrant la ligne contenant le SaveAs par
Code:

1 2 3 4 Application.DisplayAlerts = False ActiveWorkbook.SaveAs pathBureau & "\" & nomNewClasseur & ".xlsx" Application.DisplayAlerts = true
Et pour la déclaration remet Dim en début de ligne ;)

++
Qwaz

Bonjour et vraiment un très grand merci à toi, tout est OK ;)

J'ai même pu grâce à l'enregistreur de macro, faire en sorte de changer lors de l'export le fond couleur de 2 cellules via le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 ActiveSheet.Range("D2").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With ActiveSheet.Range("C34").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With
Donc j'ai pas mal appris grâce à toi ;)

Bon faut que j'optimise tout ce code afin d'utiliser des plages nommées plutôt que mettre les cellules en dur, cela sera mieux pour une évolution future ;)

Donc encore merci Qwazerty

Salut

Il faut épurer ton code plus que ça

Code:

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
 Dim NewWorkBook As Workbook, NewSheet As Worksheet
 'créer un nouveau classeur avec une seule feuille
 
    'On désactive la mise à jour de l'affichage (masque les movement à l'utilisateur
    Application.ScreenUpdating = False
 
    'Sheets("Export").Select
'    ThisWorkbook.Sheets("Export").Copy
    'Pour facilité l'écriture tu peux utiliser les codeName des onglets
    'Dans VBA c'est le nom qui apparait dans l'arborescence du projet Feuil1(Export), ici c'est Feuil1 le codename, tu peux le changer dans les propriétés (F4)
    'Ca donne pour la même ligne
    Feuil1.Copy
    'Pas principe il vaut mieux pointer le workbook dans un variable
    'Si dans la suite du code pour une raison ouù pour une autre une autre fenêtre venant au premier plan
    'ça évitera que le code déroule en utilisant le mauvais fichier (oui ça arrive...)
    'Idem avec ActiveSheet, attention
    Set NewWorkBook = ActiveWorkbook
    Set NewSheet = NewWorkBook.Sheets("Export")
    'Pas besoin de selectionner pour agir dans la suite non plus
    NewSheet.Shapes("MAJ").Delete
    NewSheet.Shapes("SauvegarderFiche").Delete
    'On simplifie avec la variable Sheet
    nomNewClasseur = "Fiche_" & NewSheet.Range("C23").Value & " " & NewSheet.Range("G23").Value
    'On désactive les messages
    Application.DisplayAlerts = False
    NewWorkBook.SaveAs pathBureau & "\" & nomNewClasseur & ".xlsx"
    NewWorkBook.Close
    'On réactive les messages
    Application.DisplayAlerts = True
 
    'On active la mise à jour de l'affichage
    Application.ScreenUpdating = True
 
    'Message pour informer que fichier bien enregistré
    MsgBox "Votre fiche est bien enregistrée sur le Bureau sous le nom : " & nomNewClasseur

++
Qwaz

Et bien encore merci de toutes ces informations et de ton aide.

Voici le résultat et je pense que c'est en effet beaucoup plus simple et plus propre que ce que j'avais depuis des années, voir mon 1er message ^^

Code:

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
    Dim pathBureau As String, nomNewClasseur As String, NewWorkBook As Workbook, NewSheet As Worksheet
 
    'définir le chemin du Bureau
    pathBureau = Environ("userprofile") & "\desktop"
    'On désactive la mise à jour de l'affichage (masque les movement à l'utilisateur
    Application.ScreenUpdating = False
    'Dupliquer l'onglet vers un nouveau fichier
    FeuilExport.Copy
    Set NewWorkBook = ActiveWorkbook
    Set NewSheet = NewWorkBook.Sheets("Export")
    'Suppression des deux boutons
    NewSheet.Shapes("MAJ").Delete
    NewSheet.Shapes("SauvegarderFiche").Delete
    'Suppression fond des cellules
    NewSheet.Range("Parente").Interior.Pattern = xlNone
    NewSheet.Range("Recu").Interior.Pattern = xlNone
    'Définir le nom du fichier
    nomNewClasseur = "Fiche_" & NewSheet.Range("Nom").Value & " " & NewSheet.Range("Prenom").Value
    'On désactive les messages
    Application.DisplayAlerts = False
    'Enregistrement du fichier
    NewWorkBook.SaveAs pathBureau & "\" & nomNewClasseur & ".xlsx"
    'On réactive les messages
    Application.DisplayAlerts = True
    'Fermeture du fichier .xlsx
    NewWorkBook.Close
    'On active la mise à jour de l'affichage
    Application.ScreenUpdating = True
    'Message pour informer que fichier bien enregistré
    MsgBox "Votre fiche est bien enregistrée sur le Bureau sous le nom : " & nomNewClasseur