Bouton annuler import des données
Bonjour, je souhaite avoir votre aide pour résoudre un problème .En fait , j ai ma macro qui permet d'importer des données à travers un chemin prédéfini.
Sub import_DATA()
' Variables objet pour le classeur et feuille source
Dim WbkS As Workbook, ShtS As Worksheet
Rep = "\\WZ0_SFTP\00_Process_System\Project_Analysis"
Application.Dialogs(xlDialogOpen).Show Rep
Set WbkS = ActiveWorkbook
Set ShtS = WbkS.Sheets("Main report") ' Attention au nom de la feuille
' Dernière ligne remplie de la feuille source
dlig = ShtS.Range("A" & Rows.count).End(xlUp).Row
' Copier / coller les données
ShtS.Range("A1:AD" & dlig).Copy Destination:=ThisWorkbook.Sheets("DATA").Range("A6")
' Fermer le classeur source sans sauvegarder
WbkS.Close Savechanges:=False
' Libérer les variables objet
Set ShtS = Nothing: Set WbkS = Nothing
End Sub
Quand l'utilisateur choisit le fichier approprié la macro s'exécute correctement mais quand il clique sur annuler une erreur d'exécution "9" s'affiche et j'arrive pas à savoir pourquoi.Merci d'avance pour votre aide.
Je dirais qu'il faut gérer le cas. Quelque chose du genre :
If NOT Rep Then MsgBox "Vous n'avez rien sélectionné": exit sub
Bonjour San, Yal_Excel
Plutôt quelque chose de ce style
Sub Import_DATA()
' Variables objet pour le classeur et feuille source
Dim WbkS As Workbook, ShtS As Worksheet
Dim sPath As String, sFic As String
' Choix du fichier
sPath = "\\WZ0_SFTP\00_Process_System\Project_Analysis\"
sFic = ChoixFichier(sPath, "CHOIX du FICHIER", "Projet, *.xlsx")
' Si choix annulé
If sFic = "" Then Exit Sub
' sinon
Set WbkS = Workbooks.Open(sFic)
Set ShtS = WbkS.Sheets("Main report") ' Attention au nom de la feuille
' Dernière ligne remplie de la feuille source
dlig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
' Copier / coller les données
ShtS.Range("A1:AD" & dlig).Copy Destination:=ThisWorkbook.Sheets("DATA").Range("A6")
' Fermer le classeur source sans sauvegarder
WbkS.Close Savechanges:=False
' Libérer les variables objet
Set ShtS = Nothing: Set WbkS = Nothing
End Sub
Function ChoixFichier(DefaultPath As String, sTitre As String, Optional sFilter As String)
' LE filtre doit être du type : "BdD Communes, *.xlsx"
Dim fd As FileDialog, TabFilter() As String
' Initialiser les variables
If Right(DefaultPath, 1) <> "\" Then DefaultPath = DefaultPath & "\"
' Initialiser l'intance du dialogue
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
' Si un filtre a été donné
If sFilter <> "" Then
TabFilter = Split(sFilter, ",")
.Filters.Add TabFilter(0), Trim(TabFilter(1))
End If
.Title = sTitre
.InitialFileName = DefaultPath
If .Show = -1 Then
ChoixFichier = fd.SelectedItems(1)
End If
End With
Set fd = Nothing
End Function
A+
Bonjour , merci beaucoup pour votre réponse. J'ai testé le code mais là j'ai un deuxième problème qui apparait dont j'arrive pas à connaitre la source. Quand je clique sur le bouton j'ai bien la fenêtre avec la trajectoire et les fichier qui s'ouvre mais quand je sélectionne un fichier et je clique ouvrir un message d'erreur apparait disant que "source introuvable".
Set WbkS = Workbooks.Open(sPath & sFic) ==> Source d'erreur
Merci d'avance pour votre aide .
Re,
Testé chez moi avant de vous donner le code, quel est la valeur de sPath & sFic
Source introuvable, c'est que le nom ou l'extension du fichier ne correspond pas à celle attendu
A+
Bonjour Bruno ,merci pour votre retour.
J'ai copié coller le chemin tel qu'il est, et s'il n'arrive pas à le trouver il aurai du remonter l'erreur dès le départ si j'ai bien compris . Mais là il m'affiche la fenêtre la trajectoire et tous les fichiers mais quand je clique dans le fichier il me remonte l'erreur "1004"
Re, J'ai remarqué que dans le message d'erreur j'ai :\\WZ0_SFTP\00_Process_System\Project_Analysis\\\WZ0_SFTP\00_Process_System\Project_Analysis\Projet1.xlsx .Est ce normal que la trajectoire soit cité deux fois ?
Edit :
J'ai mis au lieu de WbkS = Workbooks.Open(sPath & sFic) uniquement Set WbkS = Workbooks.Open(sFic) et ça a marché .
Merci.
Re,
Effectivement, désolé, le choix du fichier retourne le chemin complet avec le nom du fichier
C'est ce qu'il fallait faire
Re Bruno, merci pour votre aide. Une dernière question svp est il possible d'ajouter toutes les extensions Excel ".xl,.xlsm,.xlsb,...." ?