[VBA] Besoin d'aide pour la création d'une macro [Résolu]

[villette54]

Bonjour,

Je suis débutant en VBA, et j'ai dans le cadre de mon travail, besoin d'utiliser VBA de façon un peu plus avancée que ce que je suis capable de faire.

Il s'agit d'un fichier pour lequel je dois extraire des infos d'une "base de données" si je puis dire, et en ajouter. J'ai pour ce faire créer 4 boutons, qui doivent chacun remplir une fonction. Seulement je suis incapable de transposer ce que je souhaite dans VBA. (Toutes les explications de mes besoins se trouve sur mon document)

Je cherche donc quelqu'un qui pourrait m'aider à créer ces macros, ou au moins me mettre sur la piste parce-que actuellement, malgré tous les tutos que je consulte je suis dans le flou total.

Merci d'avance pour votre aide.

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Je comprends mieux certains de mes bugs !



Ce dossier n'existe même pas sur mon PC (chemin indiqué en dessous)

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

Coucou,

Ci-joint une version avec la taille de cellule mieux ajustée. Le problème intervenait lorsque excel refusionnait les cellules (avant la refusion, elles étaient à bonne taille). Solution : stocker dans une variable la hauteur de la cellule et forcer à bonne hauteur après la procédure buggée d'excel.

A te relire

Par ailleurs, la compression des fichiers passe bien pour limiter l'impact sur la mémoire du serveur

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Salut

Huum. Ok je comprends (comment t'as fais, mais pas pourquoi ça bug)
Je te remercie.

J'ai encore besoin de toi quelques choses si ça ne te dérange pas.
J'aimerais savoir comment définir des options d'impressions mais sans imprimer (juste au cas où, ou alors pour le prochain)
Voici ma macro actuelle :

Sub Button7_Click()

If MsgBox("Voulez-vous vraiment archiver cet enlèvement ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
  'Desactive les changement à l'écran
Application.ScreenUpdating = False

  'Déclaration de variable
Dim archive As String

    'Créer un nouveau worbook
Workbooks.Add
newclass = ActiveWorkbook.Name
    
    'Copie des cellules du classeur d'origine
Windows("Outils Facturation.xlsm").Activate
Sheets("Facture").Select
Cells.Select
Selection.Copy
    
    'Selection nouveau classeur
Windows(newclass).Activate
Sheets(1).Select
    
    'collage valeurs
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'collage format (pour les dates entre autre)
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
    
    'Chemin d'accès fichier
archive = "U:\...\Archive\" & "Enlèvement " & [G3].Value & " du " & [B1].Value & ".xlsx"
    
        'Copie des cellules du classeur d'origine
Windows("Outils Facturation.xlsm").Activate
Sheets("Encodage").Select
Cells.Select
Selection.Copy
    
    'Selection nouveau classeur
Windows(newclass).Activate
Sheets(2).Select
    
    'collage valeurs
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'collage format (pour les dates entre autre)
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    'Hide feuille inutilisée
Sheets("Sheet3").Visible = False
    
    'sauvegarde du nouveau fichier
ActiveWorkbook.SaveAs Filename:=archive, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
    
    'Retour sur classeur d'origine
Windows("Outils Facturation.xlsm").Activate
Range("A1").Select
    
      'On rétabli ce qu'on a désactivé avant
Application.ScreenUpdating = True

MsgBox "Fichier arichivé à l'adresse suivant : " & vbCrLf & archive

  Else: MsgBox "Echec de l'archivage !"
  End If
  
End Sub

Cette macro extrait 2 feuilles de mon classeur (qui en contient une dizaine) et les copie sur un nouveau classeur en valeur uniquement.
Le soucis c'est que j'aimerais ajouter des options à mes 2 feuilles :
- Marge haut/bas/gauche/droite = 0
- Option d'impression : centrée sur la feuille
- Option d'impression : feet sheet on one page (je sais pas comment ça s'appelle en français, c'est pour que un le zoom s'ajuste automatiquement de manière à tout faire rentrer sur une feuille)
- Nommée la page "encodage" sur le premier fichier "encodage" sur le second aussi (idem facturation)
- Avoir un affichage en "Page Break View" (je sais pas non plus comment ça s'appelle en français mais c'est pour n'avoir que la partie "remplie" de la feuille afficher, le reste se grise)

Ça fait beaucoup désolé ^^' mais c'est tous ce que je n'ai pas réussi à trouver par moi-même.
Si besoin je t'envoie un fichier avec la macro pour que tu visualises mieux.

Merci d'avance.

PS : désolé pour tous les commentaires, c'est pour m'y retrouver.

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

Voila ta macro avec les rajouts demandés (et légèrement retravaillée).

J'avoue que l'enregistreur de macro est mon ami sur ce coup. Je la retravaille et te fournis une version plus synthétique (y compris pour ce que tu as codé)

Sub Button7_Click()

    If MsgBox("Voulez-vous vraiment archiver cet enlèvement ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
            'Desactive les changement à l'écran
        Application.ScreenUpdating = False
        
            'Déclaration de variable
        Dim archive As String
        
            'Créer un nouveau worbook
        Workbooks.Add
        newclass = ActiveWorkbook.Name
          
            'Copie des cellules du classeur d'origine
        Windows("Outils Facturation.xlsm").Activate
        Sheets("Facture").Cells.Copy
          
            'Selection nouveau classeur
        Windows(newclass).Activate
        With Workbook(newclass).Sheets(1)
            Application.CutCopyMode = False
            .Name = "Facture" 'Nommée la page "encodage" sur le premier fichier "encodage" sur le second aussi (idem facturation)
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
            .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage format (pour les dates entre autre)
            End With
                    
          'Chemin d'accès fichier
        archive = "U:\...\Archive\" & "Enlèvement " & [G3].Value & " du " & [B1].Value & ".xlsx"
          
              'Copie des cellules du classeur d'origine
        Windows("Outils Facturation.xlsm").Activate
        Sheets("Encodage").Cells.Copy
          
          'Selection nouveau classeur
        Windows(newclass).Activate
        With Workbook(newclass).Sheets(2)
            Application.CutCopyMode = False
            .Name = "Encodage"
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
            .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage format (pour les dates entre autre)
            End With
        
            'Hide feuille inutilisée
        Sheets("Sheet3").Delete 'Sheets("Sheet3").Visible =
        
            'Défini les paramètres d'impression
        ActiveWindow.View = xlPageBreakPreview  'Avoir un affichage en "Page Break View"
        Application.PrintCommunication = False
        For i = 1 To 2 'Boucle sur les 2 pages, vu que c'est la même
            With Workbook(newclass).Sheets(1).PageSetup
                .PrintArea = "$A$1:$G$96" 'A vérifier, j'ai pris le fichier exemple de formulaire.
                .LeftHeader = ""
                .CenterHeader = ""
                .RightHeader = ""
                .LeftFooter = ""
                .CenterFooter = ""
                .RightFooter = ""
                .LeftMargin = Application.InchesToPoints(0) 'Marge haut/bas/gauche/droite = 0
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0.31496062992126)    'A définir si ok
                .FooterMargin = Application.InchesToPoints(0.31496062992126)    'A définir si ok
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlPortrait
                .Draft = False
                .PaperSize = xlPaperLetter
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                
                .Zoom = False   'Option d'impression : centrée sur la feuille
                .FitToPagesWide = 1
                .FitToPagesTall = 1
                
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = True
                .EvenPage.LeftHeader.Text = ""
                .EvenPage.CenterHeader.Text = ""
                .EvenPage.RightHeader.Text = ""
                .EvenPage.LeftFooter.Text = ""
                .EvenPage.CenterFooter.Text = ""
                .EvenPage.RightFooter.Text = ""
                .FirstPage.LeftHeader.Text = ""
                .FirstPage.CenterHeader.Text = ""
                .FirstPage.RightHeader.Text = ""
                .FirstPage.LeftFooter.Text = ""
                .FirstPage.CenterFooter.Text = ""
                .FirstPage.RightFooter.Text = ""
            End With
        Next i
        
        Application.PrintCommunication = True
          
          'sauvegarde du nouveau fichier
        ActiveWorkbook.SaveAs Filename:=archive, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
          
          'Retour sur classeur d'origine
        Windows("Outils Facturation.xlsm").Activate
        Range("A1").Select
          
            'On rétabli ce qu'on a désactivé avant
        'Application.ScreenUpdating = True 'Même commentaire qu'avant, ce paramètre est remis automatiquement à True à la fin de tes macros
        
        MsgBox "Fichier arichivé à l'adresse suivant : " & vbCrLf & archive
        
        Else: MsgBox "Echec de l'archivage !"
    End If
End Sub

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

Voici une version plus simple qui te permet de copier les feuilles à l'identique (ne copie pas les boutons et autres objets flottants).

Par contre, comme on copie tout, cela copie aussi les validations de données, les macros écrites dans la feuille, les formules, les liens vers les autres feuilles/classeurs etc etc. A voir si c'est problématique pour toi. Auquel cas, dis le moi, je repartirai de ta macro pour l'épurer.

Sub Button7_Click()
    'Desactive les changement à l'écran
    Application.ScreenUpdating = False
    
    'Déclaration de variable
    Dim archive As String
    
    If MsgBox("Voulez-vous vraiment archiver cet enlèvement ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then

            'Créer un nouveau worbook
        Set fileTarget = Workbooks.Add
        Set fileSource = Workbooks("Outils Facturation.xlsm")
        
            'Copie la feuille du classeur d'origine
        fileSource.Sheets("Facture").Copy Before:=fileTarget.Sheets(1)
        fileSource.Sheets("Encodage").Copy After:=fileTarget.Sheets(1)

            'Suppression des feuilles inutilisées
        For i = 3 To 5
            Sheets(i).Delete
            Next i
          
          'Chemin d'accès fichier
        archive = "U:\...\Archive\" & "Enlèvement " & fileSource.Sheets("Facture").[G3].Value & " du " & fileSource.Sheets("Facture").[B1].Value & ".xlsx"

          'sauvegarde du nouveau fichier
        fileTarget.SaveAs Filename:=archive, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        fileTarget.Close
          
          'Retour sur classeur d'origine
        fileSource.Range("A1").Select

        MsgBox "Fichier arichivé à l'adresse suivant : " & vbCrLf & archive
        
    Else: MsgBox "Echec de l'archivage !"
    End If
End Sub

'Défini les paramètres d'impression : Ce sont déjà les paramètres d'impression et de présentation des feuilles d'origine

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Effectivement tu as mis le doigt sur le problème.

Dans le fichier d'origine, il n'y a que des formules qui font des références à d'autres feuilles du classeur.
La démarche pour les utilisateurs est la suivante :
1. On encode sur toutes la/les feuille(s) où il y a besoin.
2. On clique sur le bouton d'archivage pour enregistrer les données.
3. On clique sur le bouton "Nettoyage feuille" pour remettre le formulaire à 0, et le remplir la fois d'après avec des nouvelles valeurs

Voilà pourquoi ma macro ne copiait pas les feuilles mais juste les données.
Puisque comme tu l'as dis, lors d'une copie de feuille cela reprend les formules (et fais des références au classeur d'origine) hors le classeur est remis à 0 après chaque utilisation. Il me faut donc extraire les valeurs qui ressortent de ces formules, et non pas copier les formules.
Ton second code ne fonctionne donc pas, puisque à chaque ouverture du fichier "copie" les valeurs se mettent à jour, donc à 0.

Je suis donc obligé de procéder en plusieurs étapes :
1. Copie des valeurs
2. Copie de la mise en page
3. Redéfinition des paramètres d'impressions.

C'est pourquoi mon code était un peu brouillon. J'avoue que j'ai plus chercher à faire un code qui fonctionne plutôt qu'un code simple !

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

Sans le fichier je ne peux faire d'essai de débogage, mais je pense que ceci devrait t'aller.

Sub Button7_Click()
    'Desactive les changement à l'écran
    Application.ScreenUpdating = False
    
    'Déclaration de variable
    Dim archive As String
    
    If MsgBox("Voulez-vous vraiment archiver cet enlèvement ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then

            'Créer un nouveau worbook
        Set fileTarget = Workbooks.Add
        Set fileSource = Workbooks("Outils Facturation.xlsm")
        
            'Copie la feuille du classeur d'origine
        fileSource.Sheets("Facture").Copy Before:=fileTarget.Sheets(1)
        fileSource.Sheets("Encodage").Copy After:=fileTarget.Sheets(1)
        For i = 1 To 2
            With fileTarget.Sheets(i).Cells
                .Copy
                .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
                End With
            Next i

            'Suppression des feuilles inutilisées
        For i = 3 To 5
            Sheets(i).Delete
            Next i
            
            'Défini les paramètres d'impression : Ce sont déjà les paramètres d'impression et de présentation des feuilles d'origine
          
          'Chemin d'accès fichier
        archive = "U:\...\Archive\" & "Enlèvement " & fileSource.Sheets("Facture").[G3].Value & " du " & fileSource.Sheets("Facture").[B1].Value & ".xlsx"

          'sauvegarde du nouveau fichier
        fileTarget.SaveAs Filename:=archive, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        fileTarget.Close
          
          'Retour sur classeur d'origine
        fileSource.Range("A1").Select
          
            'On rétabli ce qu'on a désactivé avant
        'Application.ScreenUpdating = True 'Même commentaire qu'avant, ce paramètre est remis automatiquement à True à la fin de tes macros
        MsgBox "Fichier arichivé à l'adresse suivant : " & vbCrLf & archive
        
    Else: MsgBox "Echec de l'archivage !"
    End If
End Sub

C'est pourquoi mon code était un peu brouillon. J'avoue que j'ai plus chercher à faire un code qui fonctionne plutôt qu'un code simple !

Pas de soucis là dessus c'est la première étape. Par la suite, quand tu te sentiras plus à l'aise, les codes simples seront ceux qui fonctionnent le mieux

C'est juste que je déteste tout ce qui passe par un Activate ou un Select. ça ralenti pas mal le code, et c'est assez brouillon. Malheureusement, pour les actions du type collage spécial, je ne sais pas passer outre.


Sinon, une version plus dans l'esprit de ta macro :

Sub Button7_Click()
    'Desactive les changement à l'écran
    Application.ScreenUpdating = False
    
    'Déclaration de variable
    Dim archive As String
    
    If MsgBox("Voulez-vous vraiment archiver cet enlèvement ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then

            'Créer un nouveau worbook
        Set fileTarget = Workbooks.Add
        Set fileSource = Workbooks("Outils Facturation.xlsm")
                
            'Copie des cellules du classeur d'origine
        fileSource.Sheets("Facture").Cells.Copy
        With fileTarget.Sheets(1)
            Application.CutCopyMode = False
            .Name = "Facture" 'Nommée la page "encodage" sur le premier fichier "encodage" sur le second aussi (idem facturation)
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
            .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage format (pour les dates entre autre)
            End With

            'Copie des cellules du classeur d'origine
        Sheets("Encodage").Cells.Copy
        With fileTarget.Sheets(2)
            Application.CutCopyMode = False
            .Name = "Facture" 'Nommée la page "encodage" sur le premier fichier "encodage" sur le second aussi (idem facturation)
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
            .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage format (pour les dates entre autre)
            End With
        
            'Supprime la feuille inutilisée
        Sheets(3).Delete

            'Défini les paramètres d'impression
        fileTarget.Activate
        ActiveWindow.View = xlPageBreakPreview  'Avoir un affichage en "Page Break View"
        Application.PrintCommunication = False
        For i = 1 To 2 'Boucle sur les 2 pages, vu que c'est la même
            With Workbook(newclass).Sheets(1).PageSetup
                .PrintArea = "$A$1:$G$96" 'A vérifier, j'ai pris le fichier exemple de formulaire.
                .LeftMargin = Application.InchesToPoints(0) 'Marge haut/bas/gauche/droite = 0
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0)    'A définir si ok
                .FooterMargin = Application.InchesToPoints(0)    'A définir si ok

                .Zoom = False   'Option d'impression : centrée sur la feuille
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
        Next i
        Application.PrintCommunication = True
         
          'sauvegarde du nouveau fichier
        archive = "U:\...\Archive\" & "Enlèvement " & [G3].Value & " du " & [B1].Value & ".xlsx" 'Chemin d'accès fichier
        fileTarget.SaveAs Filename:=archive, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        fileTarget.Close
         
          'Retour sur classeur d'origine
        fileSource.Range("A1").Select
        MsgBox "Fichier arichivé à l'adresse suivant : " & vbCrLf & archive
       
        Else: MsgBox "Echec de l'archivage !"
    End If
End Sub

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Merci beaucoup!

Je n'ai pas encore essayé je te tiens au courant dès que j'en ai eu l'occasion.
Par contre en lisant le code, j'avoue ne pas comprendre cette partie

 'Copie la feuille du classeur d'origine
        fileSource.Sheets("Facture").Copy Before:=fileTarget.Sheets(1)
        fileSource.Sheets("Encodage").Copy After:=fileTarget.Sheets(1)
        For i = 1 To 2
            With fileTarget.Sheets(i).Cells
                .Copy
                .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
                End With
            Next i

C'est quoi cette histoire de copy before et copy after ?

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Bon, même si je ne comprends pas trop le code. L'essentiel est là : il fonctionne.
En revanche, 2 problèmes se posent :
- La copie de la page entière reprend même les "boutons d'action" qui du coup ne fonctionne plus.
- Le fait de supprimer les autres pages (les vides) est dérangeant (c'est pour ça que j'avais juste hide) à chaque suppression de page, cela me demande une confirmation : êtes vous sur de vouloir supprimer cette page blablah.

Je pars tester le second code !

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

La commande magique pour éviter un certain nombre de messages à la con :

Application.DisplayAlerts = False

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Bon le second code ne marche pas (plusieurs erreurs que je ne comprends pas)

J'avais essayé la commande Application.DisplayAlerts = False
Mais sans succès.

J'ai essayé de virer toutes les données de mon fichier pour t'en donner une copie, je l'ai massacré mais l'essentiel de la structure est encore là je pense.

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

Bon, visiblement, excel n'aime pas les collages spéciaux dans des dossiers non activés ... ( ) Du coup, ma macro recourt au Joker de l'activate...

Sub Button7_Click()
    'Desactive les changement à l'écran
    Application.ScreenUpdating = False

   
    'Déclaration de variable
    Dim archive As String
   
    If MsgBox("Voulez-vous vraiment archiver cet enlèvement ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then

            'Créer un nouveau worbook
        Set fileTarget = Workbooks.Add
        Set fileSource = Workbooks("Outils Facturation.xlsm")
        fileTarget.Activate
        Application.CutCopyMode = False
       
            'Copie des cellules du classeur d'origine
        nomFeuille = Array("Facture", "Encodage")
        For i = 0 To UBound(nomFeuille)
            fileSource.Sheets(nomFeuille(i)).Cells.Copy
            With fileTarget.Sheets(i + 1) 'car le tableau commence à l'indice 0. Pour changer cela, utiliser la commande Option Base 1
                .Name = nomFeuille(i) 'Nommée la page "encodage" sur le premier fichier "encodage" sur le second aussi (idem facturation)
                .Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage valeurs
                .Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'collage format (pour les dates entre autre)
                End With
            Next i
       
            'Cache la feuille inutilisée
        Sheets(3).Visible = False

            'Défini les paramètres d'impression
        Application.PrintCommunication = False
        Application.DisplayAlerts = False
        For i = 1 To 2 'Boucle sur les 2 pages, vu que c'est la même
           fileTarget.Sheets(i).Activate
            ActiveWindow.View = xlPageBreakPreview 'Avoir un affichage en "Page Break View"
           With fileTarget.Sheets(i).PageSetup
                .PrintArea = "$A$1:$i$56" 'A vérifier, j'ai pris le fichier exemple de formulaire.
                .LeftMargin = Application.InchesToPoints(0) 'Marge haut/bas/gauche/droite = 0
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0)    'A définir si ok
                .FooterMargin = Application.InchesToPoints(0)    'A définir si ok
                .Zoom = False   'Option d'impression : centrée sur la feuille
                .FitToPagesWide = 1
                .FitToPagesTall = 1
                End With
            Next i
        Application.PrintCommunication = True
        Application.DisplayAlerts = True
         
          'sauvegarde du nouveau fichier
        archive = "U:\Registres\Registre déchets\docs 2013\Archive\" & "Enlèvement " & [G3].Value & " du " & [B1].Value & ".xlsx" 'Chemin d'accès fichier
        fileTarget.SaveAs Filename:=archive, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        fileTarget.Close
         
          'Retour sur classeur d'origine
        fileSource.Range("A1").Select
        MsgBox "Fichier arichivé à l'adresse suivant : " & vbCrLf & archive
       
    Else
        'En cas d'annulation
        MsgBox "Echec de l'archivage !"
        End If
End Sub

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Salut.
Mon Excel a décidé de ne pas fonctionné aujourd'hui. (Il plante et redémarre dès que je clique quelque part)

Je ne peux donc pas tester ta macro pour le moment désolé.
Je te tiens au courant dès que j'ai pu la tester.

Merci

 

[villette54]

Re : [VBA] Besoin d'aide pour la création d'une macro

Salut.
Après plusieurs essais hier et aujourd'hui c'est ce code qui fait totalement planter mon Excel.

En revanche, juste un dernier petit truc et après j'arrête de te harceler.
Peut-on en revenir au formulaire ?

J'aimerais encore 2 petites modifications :
1. Lorsque l'on supprime le texte contenu dans une des cellules avec la taille automatique, j'aimerais que la taille de la cellule se remette "par défaut" car actuellement elle reste à la taille qu'elle avait avec le texte dedans.
2. J'ai 3 menus déroulants interdépendants (Secteur/zone/sous-zone) sur 3 hauteur donc (Il faut choisir un secteur avant une zone, et une zone avant une sous-zone) j'aimerais donc si possible que lorsque que l'on change le secteur par exemple, la zone et la sous zone se remettent à 0. Et si on change de zone, la sous-zone se remet également à 0.

J'espère que j'ai été clair, je te remet le fichier au cas où. Merci.
http://cjoint.com/?3InjBl6PWXF

 

[Tirou]

Re : [VBA] Besoin d'aide pour la création d'une macro

Voila pour la mise en forme.

Par contre, pour ton fichier, est-ce que tu peux faire fonctionner ma macro ligne après ligne avec la touche F8? histoire de voir où ça coince.