Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Matjul

XLDnaute Occasionnel
Bon premier mai à tous,

Afin de combler cette triste journée loin du boulot je fais appel à vos lumières.
Ce que je veux faire :
J'ai créé un formulaire de saisie et voudrais exporter la feuille active soit dans un nouveau classeur, soit dans un classeur existant.
C'est sur ce test que je ne sais pas comment procéder. Je me suis créé une cellule dans laquelle j'ai concaténé les éléments permettant de valoriser l'arborescence + le nom du fichier théorique (ex. C/classeur_test/[valeur d'une cellule]+[Valeur d'une autre cellule]+[quantième ou date du jour].xls)
J'essaie de trouver un moyen d'affecter la valeur de cette cellule à une variable "arborescence" dans le programme VB et tente désespérément de trouver une fonction me permettant de comparer cette valeur à l'existant, si elle existe j'insère simplement une feuille sinon je crée un classeur avec cette feuille sous "arborescence".

C'est sûrement simple mais je tourne en rond sur les différents forums ou dans le help.

Merci.

Matjul
 

jp14

XLDnaute Barbatruc
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonjour

Une piste

Ouvrir le fichier, s'il n'existe pas une erreur est générée.
En écrivant avant la ligne qui produit l'erreur
Code:
On error Goto gesterreur
' code qui provoque une erreur
On error goto 0 ' pour supprimer la gestion de l'erreur

..............................
exit sub ' ne pas oublier ce code sinon on rentre dans la gestion de l'erreur
' traitement erreur
gesterreur:

' code pour corriger l'erreur

resume next ' pour retourner à la ligne suivante
end sub

A tester

JP
 

dudu29

XLDnaute Nouveau
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Salut,

voici un bout de code qui pourrait faire l'affaire

Option Explicit
Sub test()
Dim monclasseur As Object
'On Error Resume Next 'permet de recuperer l'erreur
Set monclasseur = GetObject(Range("a1")) 'dans la cellule a1 place le chemin ainsi que le nom du fichier
If Err <> 0 Then 'signifier que le fichier n'existe pas
Err.Clear
ThisWorkbook.SaveAs Range("a1") 'sauve le classeur actuel sous le nouveau nom
Else
With monclasseur
monclasseur.Sheets.Add 'ici faire la manip pour copie votre feuille
ThisWorkbook.Sheets(1).Range("a1").Copy Destination:=monclasseur.Sheets(1).Range("a1")
End With
monclasseur.SaveAs Range("a1") 'sauve le classeur
monclasseur.Close
Set monclasseur = Nothing
End If
End Sub

a plus
dudu
 

Pierrot93

XLDnaute Barbatruc
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonsoir à tous

une autre solution pour tester si un fichier existe :

Code:
Dim fso As Object, x As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
x = fso.FileExists("C:\Documents and Settings\Nom Utilisateur\Mes documents\Excel\NomClasseur.xls")
If x = True Then MsgBox "fichier existe"

bonne soirée
@+
 

Matjul

XLDnaute Occasionnel
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonjour à tous et merci pour vos réponse.
J'ai donc tapé le code suivant:
Code:
Private Sub Enregistrer_Click()

'Vérifie si le classeur existe déjà
Dim fso As Object, x As Boolean
Dim Nomfeuil As String

Set fso = CreateObject("Scripting.FileSystemObject")
x = fso.FileExists("C:\Test\" & TextBox1.Value & ".xls")

If x = True Then Nomfeuil = TextBox1.Value & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) 'Crée une feuille avec le nom du produit et la date
Set Tafeuille = Feuil2  'A définir en fonction de tes besoins
Tafeuille.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Nomfeuil
initialise
Else 'Crée un nouveau classeur avec le nom du produit
ChDir "C:\Test"
    ActiveWorkbook.SaveAs Filename:= _
"C:\Test\" & TextBox1.Value & ".xls", _
       FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.Save
   Application.Quit

End Sub

Mais malheureusement cela ne fonctionne pas.
Pouvez vous me corriger mon erreur ?
Je vous rappelle le principe,
Dans une userform, j'écris le nom d'um produit et je clique sur un bouton enregistrer.
Si le nom du produit n'existe pas alors cela crée un classeur portant le nom du produit et cela insère la feuille (remplie à partir du userform) avec la date du jour dans ce nouveau classeur.

En revanche, si le classeur portant le nom du produit existe déjà, alors cela vient simplement insérer la nouvelle feuille avec la date du jour a la suite des autres feuilles.

Merci pour votre aide
 

Pierrot93

XLDnaute Barbatruc
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonsoir à tous

aarf, je n'ais rien, lu trop vite, désolé...


bonne soirée
@+

Edition : texte modifié, lu trop vite...
 
Dernière édition:

skoobi

XLDnaute Barbatruc
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonjour Matjul,
salut Pierrot ,

A tester:

Code:
Sub Macro1()
Private Sub Enregistrer_Click()

'Vérifie si le classeur existe déjà
Dim fso As Object, x As Boolean
Dim Nomfeuil As String

Set fso = CreateObject("Scripting.FileSystemObject")
x = fso.FileExists("C:\Test\" & TextBox1.Value & ".xls")
Set Tafeuille = Feuil2  'A définir en fonction de tes besoins

If x = True Then Nomfeuil = TextBox1.Value & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) 'Crée une feuille avec le nom du produit et la date
  Tafeuille.Copy After:=Sheets(Sheets.Count)
  ActiveSheet.Name = Nomfeuil
  initialise
Else 'Crée un nouveau classeur avec le nom du produit
  Set NewFile = Workbooks.Add
  Tafeuille.Copy After:=Sheets(Sheets.Count)
  ActiveSheet.Name = Nomfeuil
  NewFile.SaveAs Filename:= _
  "C:\Test\" & TextBox1.Value & ".xls", _
  FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  ReadOnlyRecommended:=False, CreateBackup:=False
  Application.Quit
End If
End Sub
 

Matjul

XLDnaute Occasionnel
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonsoir Skoobi,
Je viens de tester la macro, et il y a un message d'erreur: "Else sans If"
Je ne comprends pas...
Merci
 

skoobi

XLDnaute Barbatruc
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Re,

arffff, oui, il faut aller à la ligne après "Then":

Code:
If x = True Then 
Nomfeuil = TextBox1.Value & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) 'Crée une feuille avec le nom du produit et la date
Tafeuille.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Nomfeuil
initialise
..........
............
 

Matjul

XLDnaute Occasionnel
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonjour Skoobi,
Je viens de tester à nouveau le code et je rencontre le problème suivant:
Si le classeur existe déjà, la feuille vient s'insérer dans le classeur ouvert mais pas dans celui de destination.
En revanche, si le classeur n'existe pas, le débogage se met en route.
Voici le code
Code:
Sub Enregistrer_Click()

'Vérifie si le classeur existe déjà
Dim fso As Object, x As Boolean
Dim Nomfeuil As String

Set fso = CreateObject("Scripting.FileSystemObject")
x = fso.FileExists("C:\Test\" & TextBox1.Value & ".xls")
Set Tafeuille = Feuil2  'A définir en fonction de tes besoins

If x = True Then
  Nomfeuil = TextBox1.Value & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) 'Crée une feuille avec le nom du produit et la date
  Tafeuille.Copy After:=Sheets(Sheets.Count)
  ActiveSheet.Name = Nomfeuil
  initialise
Else 'Crée un nouveau classeur avec le nom du produit
  Set NewFile = Workbooks.Add
  Tafeuille.Copy After:=Sheets(Sheets.Count)
  ActiveSheet.Name = Nomfeuil
  NewFile.SaveAs Filename:= _
  "C:\Test\" & TextBox1.Value & ".xls", _
  FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  ReadOnlyRecommended:=False, CreateBackup:=False
  Application.Quit
End If

Merci pour votre aide
 

skoobi

XLDnaute Barbatruc
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Re bonjour,
Là tu dis:
Si le classeur existe déjà, la feuille vient s'insérer dans le classeur ouvert mais pas dans celui de destination.
Et plus haut tu dis:
En revanche, si le classeur portant le nom du produit existe déjà, alors cela vient simplement insérer la nouvelle feuille
.
Tu te contredis.

En revanche, si le classeur n'existe pas, le débogage se met en route.
Quel est le message d'erreur et sur quel ligne? J'ai oublié ma boule de cristal au boulo
 

Matjul

XLDnaute Occasionnel
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonsoir,
Non, je ne me contredis pas, dans le premier post, j'ai écrit ce que je souhaitais, et dans le dernier, j'ai écrit le résultat de ce que me donne le code actuel.

En ce qui concerne le message d'erreur c'est:
"Erreur d'éxécution 1004
Erreur définie par l'application ou par l'objet"
Puis c'est cette ligne là "ActiveSheet.Name = Nomfeuil" qui est soulignée.

Merci encore
 

Matjul

XLDnaute Occasionnel
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Peut être que le classeur test pourrait vous aider a comprendre ce que je cherche.
 

Pièces jointes

  • Test.zip
    22 KB · Affichages: 95
  • Test.zip
    22 KB · Affichages: 94
  • Test.zip
    22 KB · Affichages: 96

Matjul

XLDnaute Occasionnel
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonjour à tous,
Cela fait plusieurs jours que je tente de modifier le code afin d'obtenir ce que je souhaite, mais sans aucun résultat, et toujours les mêmes problèmes.
Pourriez vous m'aider à avancer?

Pour résumer, je tappe le nom d'un produit dans la textbox d'un userform.
En cliquant sur enregistrer, je souhaite:
- si le classeur portant le nom du produit existe, alors insérer la feuille2 avec pour nom la date du jour dans ce classeur.
- si le classeur avec le nom du produit n'existe pas, alors créer ce classeur et lui attribuer comme nom celui du produit (textbox1.value), et y insérer la feuille2 qui portera elle aussi la date du jour.

Merci pour votre aide
 
G

Guest

Guest
Re : Fonction VBA Pour vérifier l'existence d'un classeur "test.xls"

Bonjour Matjul,
bonjour Skoobi même si t'es en Week-End
Salut tout le monde

Voici le code de notre ami Skoobi, un peu modifié afin que le classeur cherché s'il existe soit ouvert avant d'insérer la feuille, puis ensuite refermé.

Code:
 Sub Enregistrer_Click()
'Vérifie si le classeur existe déjà
Dim fso As Object, x As Boolean
Dim Nomfeuil As String
Set fso = CreateObject("Scripting.FileSystemObject")
'x = fso.FileExists("C:\Test\" & TextBox1.Value & ".xls")
x = fso.FileExists(ThisWorkbook.Path & "\" & TextBox1.Value & ".xls")
Set Tafeuille = Feuil2  'A définir en fonction de tes besoins
If x = True Then
  'Décommenter la ligne suivante après les tests
  'Application.ScreenUpdating=False
  
  Workbooks.Open "C:\Test\" & TextBox1.Value & ".xls"
  Nomfeuil = TextBox1.Value & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) 'Crée une feuille avec le nom du produit et la date
  
  Tafeuille.Copy Before:=ActiveWorkbook.Sheets(1)
  ActiveSheet.Name = Nomfeuil
  
  Application.DisplayAlerts = False
  ActiveWorkbook.Save
  ActiveWorkbook.Close
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  initialise
Else 'Crée un nouveau classeur avec le nom du produit
  Set NewFile = Workbooks.Add
  Tafeuille.Copy After:=Sheets(Sheets.Count)
  ActiveSheet.Name = Nomfeuil
  NewFile.SaveAs Filename:= _
  "C:\Test\" & TextBox1.Value & ".xls", _
  FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
  ReadOnlyRecommended:=False, CreateBackup:=False
  Application.Quit
End If
End Sub

A tester

A beintôt
 

Discussions similaires

Réponses
20
Affichages
503
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…