Probleme avec code pour copier feuille Excel 2007

Le 15/01/2017 à 18:23

Bonjour à toutes et à tous

Voici mon souci,

J'ai un problème avec l'exécution d'un code, il s'agit de copier la dernière feuille d'un classeur, qui se trouve sur mon volume "C" vers mon volume "A", en vue d'une sauvegarde de celle-ci.

Cette feuille a la cellule "A3" qui contient des éléments concaténer, qui donnent le nom du classeur final.

Le code s'exécute bien, mais au lieu de sauvegarder ce classeur dans le fichier qui se trouve dans le volume "A", il me fait la sauvegarde dans le volume "C", à la suite de mes autres fichiers.

Je pense que cela est dû au nom que je lui demande de donner, parce que j'ai un autre code qui s'exécute bien et au bon endroit.

Il s'agit également d'une sauvegarde, mais qui porte le même nom que l'original, j'y ajoute uniquement la date et l'heure. Je vous joints les deux codes, si vous pouviez m'aiguiller vers ce qui coince, ce serait sympa.

En résumé je sauvegarde le fichier facture en copie que je renomme au nom de la dernière feuille qui est la facture à conserver, et je renomme le fichier par le nom et le n° de la facture se trouvant en "A3", puis je supprime les feuilles qui me servent pour éditer ma facture, afin de ne conserver que la facture, cela pour alléger mon dossier, et par la même occasion mon PC.

Voici le code qui ne fait pas exactement ce que je souhaite( la place de l'enregistrement)

  

   'Je sauvegarde le fichier Facture'
    ActiveWorkbook.Save

 'Je memorise mon fichier actuel'
 mempath = ThisWorkbook.FullName

        'Sélectionne le dernier onglet du classeur.
    Sheets(Sheets.Count).Select

                    'Je sauvegarde le classeur dans le fichier dont le chemin est spécifié'
    Chemin = "A:\Sauvegarde facturation 2017\Sauvegarde Facturation"

                    ' le nom du fichier
    nom = Range("A3") & ".xlsm"

                    'Je sauvegarde le nouveau fichier
    ThisWorkbook.SaveAs (nom)

        Sheets("Facture").Activate

                    'J'affiche les feuilles masquées'

    Sheets("List").Visible = True

                     ' Je selectionne les feuilles a supprimer'

       Application.DisplayAlerts = False
    Sheets(Array("Facture", "List", "ListeFacture")).Select

                    ' Je supprime les feuilles selectionnées

    ActiveWindow.SelectedSheets.Delete
   Application.DisplayAlerts = True

Question:

Pourquoi cela s'enregistre sur le volume "C" alors que je lui ai indiqué le volume "A" ?

Surtout que j'ai une autre partie de code que j'utilise, qui lui fonctionne très bien, ressemble un peu au code qui ne remplit pas sa tâche, mis à part que l'un s'enregistre presqu' à l'identique, et que l'autre doit donner un nom de classeur différent.

Je vous joints le code qui est quasiment identique qui lui fonctionne

'Je sauvegarde'
    ActiveWorkbook.Save

Chemin = "A:\Dossier facturation Seb répare\Sauvegarde facturation 2017\Sauvegarde suivi clients"
'Ajoute la date du jour et l'heure dans le nom du fichier
fichier = "SuiviClient.xlsm" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"

ActiveWorkbook.SaveCopyAs Chemin & fichier

Je vous remercie par avance de votre aide

Cordialement

Dubdub22

Le 15/01/2017 à 18:30

Bonjour,

Essaie :

ThisWorkbook.SaveAs (Chemin & "/" & nom)
Le 16/01/2017 à 10:35

Bonjour Jean Eric,

Merci de ta tentative d'aide mais cela ne fonctionne toujours pas.

Je viens d'essayer en mettant en direct sur "C", et c'est exactement pareil, je ne comprends pas pourquoi.

J'ai 4 enregistrements dans mon code, 3 fonctionnent (ce sont ceux qui ne changent pas de noms) et le seul qui change de nom c'est lui qui ne s'enregistre pas au bon endroit, il s'enregistre avec le bon nom, mais pas dans le fichier ou il devrait, puisqu'il se place dans mes documents à la suite de tous mes fichiers

merci quand même de ton aide

Cordialement

Dubdub22

Le 16/01/2017 à 11:16

Bonjour Dubdub22, Jean-Eric,

Par rapport à la proposition de Jean-Eric, ne faudrait-il pas mettre "\" au lieu de "/" ??

Le 16/01/2017 à 11:29

Bonjour,

Ta commande ThisWorkBook.SaveAs ne tient compte que de la valeur de la cellule A3 (qui contient, je suppose, uniquement le nom du fichier). Le chemin complet n'étant pas renseigné, le classeur est enregistré dans le dossier par défaut.

Cédric

Le 16/01/2017 à 15:35

Bonjour à tous,

Hélas Melch, j'y ai pensé mais cela ne change rien, merci quand même

Cédric comment formulerais-tu la commande ?

Ce que je mets ci-dessous s'affiche en marron ton avis ?

 
  ThisWorkbook.SaveAs ("A:\Sauvegarde facturation 2017\Sauvegarde Facturation & " / " & nom")

N'étant pas un pro du VBA, parfois je coince

Merci à tous pour votre aide

Cordialement

Dubdub22

Le 16/01/2017 à 15:56

Bonjour Dudub,

Après lecture de l'aide sur la méthode Workbook.SaveAs, il faut modifier la propriété FileFormat.

En reprenant la syntaxe proposée par Jean-Eric :

ThisWorkbook.SaveAs (Chemin & "\" & nom, xlOpenXMLWorkbookMacroEnabled)
Le 17/01/2017 à 14:09

Bonjour Cédric,

Merci pour votre réponse cela fonction, le seul petit souci, c'est qu'il me ferme le fichier original, alors que j'aimerais qu'il reste ouvert pour y revenir ensuite.

Merci encore pour votre aide

Cordialement

Dubdub22

Le 17/01/2017 à 15:50

Bonjour Dudub,

La méthode SaveAs ne ferme pas le classeur. Peux-tu copier toute ta procédure ?

Le 17/01/2017 à 17:00

Re-Bonjour Cédric,

Je vous joints une copie du fichier du fichier test avec les explications dedans.

Merci de votre aide

Cordialement

Dubdub22

15test1.xlsm (20.36 Ko)
Le 18/01/2017 à 12:01

Bonjour Dudub,

Ci-joint une solution, teste la pour voir si elle correspond à ton besoin.

Quelques explications/informations :

  • Tous les 'paramètres' de la procédures qui sont à changer sont au début de la procédure (ex. dossier de destination)
  • Tout au long de la procédure, on vérifie différents éléments : existence du dossier de destination, d'un fichier déjà présent, du bon enregistrement,...
  • Globalement, la procédure est la suivante : Enregistrement du classeur en format .xlsx (2007, sans macro). Suppression des onglets. Ouverture du classeur originel. Fermeture du classeur enregistré.
  • J'ai inclus une petite gestion des erreurs, à toi de voir si tu veux la garder
  • Attention aux balises si tu renommes la procédure. Pense à les changer (sinon ça ne sera pas compréhensible)

Cédric

Sub EXportWB()
'====Déclaration des Variables====
Dim strDestPath As String 'Chemin de destination
Dim strDestFileName As String 'Nom du fichier de destination
Dim strWBPath As String 'Chemin du classeur actuel
Dim arrWBName() As String 'Nom du classeur actuel
'====

'====PARAMÈTRES DE LA PROCÉDURE====
Application.EnableEvents = False 'Désactive les évènements
Application.ScreenUpdating = False 'Désactive l'actualisation de l'écran
On Error GoTo Err_EXportWB 'Gestion des Erreurs
strDestPath = "C:\Users\SYGA_CEDRIC\Desktop\" 'Chemin de destination
strDestFileName = ThisWorkbook.ActiveSheet.Range("A1") 'Récupération du nom sous lequel enregistrer le fichier
'====

'====Récupération des informations & contrôle====
strWBPath = ThisWorkbook.FullName 'Chemin du classeur actuel
arrWBName = Split(ThisWorkbook.Name, ".") 'Nom du classeur actuel

'Empêche l'enregistrement si le classeur de destination a le même nom que le classeur actuel
If strDestFileName = arrWBName(UBound(arrWBName) - 1) Then
    MsgBox "IMPOSSIBLE D'ENREGISTRER LA COPIE AVEC LE MÊME NOM" & vbNewLine & vbNewLine & "PROCÉDURE ANNULÉE" _
            , vbOKOnly + vbCritical, "ERREUR"
    GoTo Fin_EXportWB
End If

If InStr(1, "/\", Right(strDestPath, 1)) = 0 Then strDestPath = strDestPath & "\" 'Ajoute un '\' à la fin du dossier
Application.DisplayAlerts = False 'Désactive les alertes système

'Contrôle de l'existence du dossier de destination
If Dir(Mid(strDestPath, 1, Len(strDestPath) - 1), vbDirectory) = "" Then
    MsgBox "LE DOSSIER DE DESTINATION N'EXISTE PAS" & vbNewLine & vbNewLine & "PROCÉDURE ANNULÉE" _
            , vbOKOnly + vbCritical, "ERREUR"
    GoTo Fin_EXportWB
End If

 'Contrôle de l'existence du fichier de destination
If Dir(strDestPath & strDestFileName & ".xlsx") <> "" Then
    Select Case MsgBox("LE FICHIER (" & strDestPath & strDestFileName & ".xlsx) EXISTE DÉJA. L'ÉCRASER ?" _
                        , vbYesNoCancel, "INFORMATION")
        Case Is = vbYes
        Case Is = vbNo, vbCancel
            GoTo Fin_EXportWB
        Case Else
    End Select
End If
'====

'====Enregistrement du classeur====
With ThisWorkbook
    .SaveAs strDestPath & strDestFileName & ".xlsx", xlWorkbookDefault 'Sauvegarde le classeur (format 2007 sans macro)
    DoEvents 'Rend la main au système

    'Vérification de l'enregistrement
    If Dir(strDestPath & strDestFileName & ".xlsx") = "" Then
        MsgBox "IMPOSSIBLE D'ENREGISTRER LE CLASSEUR", vbOKOnly + vbCritical, "ERREUR"
        GoTo Fin_EXportWB
    End If

    .Sheets("Feuil1").Activate 'Active 'Feuil1'
    .Sheets(Array("Feuil2", "Feuil3")).Delete 'Supprime les onglets
    .Save 'Sauvegarde le classeur
End With

Workbooks.Open strWBPath 'Ouvre le classeur originel
'====

'====SORTIE DE LA PROCÉDURE & GESTION DES ERREURS====
MsgBox "LA PROCÉDURE " & "//DESCRIPTION//" & " S'EST DÉROULÉE AVEC SUCCÈS !", vbOKOnly + vbInformation, "INFORMATION"
ThisWorkbook.Close 'Ferme le classeur nouvellement enregistré
'Message utilisateur : Procédure OK
Fin_EXportWB: 'Balise FIN
Application.EnableEvents = True 'Active les évènements
Application.ScreenUpdating = True 'Active l'actualisation de l'écran
Application.DisplayAlerts = True 'Active les alertes système
Exit Sub 'Sortie de la Fonction/Procédure
On Error GoTo 0 'Gestion Normale des Erreur

Err_EXportWB: 'Balise ERREURS
'Si erreur, alerte utilisateur et demande si reprise procédure
If MsgBox("LA PROCÉDURE " & "//DESCRIPTION//" & " A GÉNÉRÉ UNE ERREUR :" & vbNewLine & _
    "LIGNE " & Erl() & " - ERREUR N°" & Err.Number & " : " & UCase(Err.Description) & _
              vbNewLine & vbNewLine & "REPRENDRE ?", vbCritical + vbYesNo, "ERREUR") = vbYes Then
    Select Case Err.Number 'Actions à faire en fonction du n° d'erreur
        Case Is = 0 'Erreur n°...
        Case Is = 1 'Erreur n°...
        Case Else 'Erreur n°...
    End Select
    Err.Clear 'Vide l'erreur
    Resume 'Reprend la procédure
Else
    Err.Clear 'Vide l'erreur
    GoTo Fin_EXportWB
End If
'====

End Sub
12test1.xlsm (29.32 Ko)
Rechercher des sujets similaires à "probleme code copier feuille 2007"