verifier presence fichier avant enregistrement

P

PEX

XLDnaute Occasionnel
bonjour,

je vous expllique simplement :
Je souhaite lors de l'enregistrement d'un fichier qu'il verifie au prealable s'il est existant avant de l'enregistrer et si c 'est le cas il annule l'enregistrement.
Je n'y arrive vraiment pas .. je vous laisse mon code pour que sa vous aide ..

cordialement

Code: 
Private Sub save_Click()





    Dim X, occurence As Integer
    Dim R As Range
    Dim ligne As Long
    Dim trouve As Boolean 'déclare la variable trouvé
    Dim chr, chr1 As String
    Dim question As Long
      
       
    If cbproduit = "" Then
    question = MsgBox("Entrer un nom Produit !", vbCritical, "Information Manquante")
     End If
  
    
        trouve = False
        occurence = 0
        ligne = 1
        Label_Alerte = ""
               
        '=======================================================
        'Recherche les produits parmis les primaires
        '=======================================================
        Set R = ThisWorkbook.Sheets("primaire").Range("A:A").Find(what:=cbproduit.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then             trouve = True
            For Each R In ThisWorkbook.Sheets("primaire").Range("A65536:A" & ThisWorkbook.Sheets("primaire").Range("A:A").End(xlDown).Row)
                If R.Text = cbproduit.Value Then
                Workbooks.Open "C:\Documents and Settings\s558670\Bureau\modele_fiche_suiveuse.xlsx"
                               
              With ThisWorkbook
                        occurence = 0
                        
                           Range("C5").Value = .Sheets("primaire").Range("D" & R.Row).Value
                           Range("C6").Value = .Sheets("primaire").Range("C" & R.Row).Value
                           Range("G5").Value = .Sheets("primaire").Range("A" & R.Row).Value
                           Range("G6").Value = .Sheets("primaire").Range("P" & R.Row).Value
                           Range("G7").Value = .Sheets("primaire").Range("I" & R.Row).Value
                           Range("A10").Value = .Sheets("primaire").Range("AJ" & R.Row).Value
                           Range("B10").Value = .Sheets("primaire").Range("J" & R.Row).Value
                           Range("C10").Value = .Sheets("primaire").Range("K" & R.Row).Value
                           Range("D10").Value = .Sheets("primaire").Range("R" & R.Row).Value
                           Range("E10").Value = .Sheets("primaire").Range("T" & R.Row).Value
                           Range("F10").Value = .Sheets("primaire").Range("S" & R.Row).Value
                           Range("G10").Value = utilisation
                                                                        
                   End With
                 
                End If
            Next R
            occurence = 0
        End If
      


     chr = Range("format!G5")
    chr1 = Range("format!C5")


    ChDrive "c"
    ChDir "C:\Documents and Settings\s558670\Bureau\"
            ActiveWorkbook.SaveAs Filename:=(chr) & "_" & (chr1)

question = MsgBox("voulez vous visualiser la fiche suiveuse ?", vbYesNo + vbQuestion, " Suggestion ")
If question = vbYes Then
Workbooks.Open "C:\Documents and Settings\s558670\Bureau\" & chr & "_" & chr1 & ".xlsx"
End If
If question = vbNo Then
ActiveWorkbook.Close
End If
Unload fiche_suivi
End Sub
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : verifier presence fichier avant enregistrement

Bonjour à tous

Essaies de t'inspire de cet exemple fourni par MJ13 (issu des discussion similaires en bas de la page)
https://www.excel-downloads.com/thr...e-dans-un-dossier-avant-enregistremnt.182828/

ou sinon utilises cette fonction comme dans l'exemple ci-dessous
Code: 
Function existe(PathAndFileName$) As Boolean
Dim objFSo
Set objFSo = CreateObject("Scripting.FileSystemObject")
existe = objFSo.FileExists(PathAndFileName)
End Function
VB: 
Sub test()
Dim Fichier$
Fichier = "c:\temp\test.xls" 'à adapter ou créer pour tester la macro
If existe(Fichier) Then
'ton code VBA à éxécuter
'PS: Ligne ci-dessous pour illustration, donc facultative, sauf si tu adores cette chanteuse ;-)
MsgBox "Résiste, prouve que tu existes" & Chr(13) & "Mon nom est: " & Fichier, 64, "En direct des années 80, France Gall!"
Else
'on sort
End
End If
End Sub
 
Vote positif 0 Vote négatif
Dormeur74

Dormeur74

XLDnaute Occasionnel
Re : verifier presence fichier avant enregistrement

Bonjour tout le monde,

Petit exemple tout simple :

Code: 
    fichier = "classeur1.xls"
    dossier = "c:\dossier\"

    ' Si ce fichier existe on ne l'écrase pas
    If Dir(fichier & dossier)<>"" Then 
        Exit Sub ' ou autre chose, une demande de confirmation par exemple
    End If

...et bon week-end
 
Vote positif 0 Vote négatif
camarchepas

camarchepas

XLDnaute Barbatruc
Re : verifier presence fichier avant enregistrement

Bonjour,

J'ai revu l'ensemble de cette portion de code, pas de chose dramatique mais si jamais ça peut faire avancer le schmilblick ....

Et j'ai rajouté le test d'existence du fichier et un message d'information.

Code: 
Private Sub save_Click()

    Dim X As Integer, occurence As Integer
    Dim R As Range
    Dim ligne As Long
    Dim trouve As Boolean 'déclare la variable trouvé
    Dim chr As String, chr1 As String
    Dim question As Long
    Dim Racine As String
    
    If cbproduit = "" Then
      question = MsgBox("Entrer un nom Produit !", vbCritical, "Information Manquante")
    End If
 
    Racine = "C:\Documents and Settings\s558670\Bureau\"
    trouve = False
    occurence = 0
    ligne = 1
    Label_Alerte = ""
               
    '=======================================================
    'Recherche les produits parmi les primaires
    '=======================================================
    
    Set R = ThisWorkbook.Sheets("primaire").Range("A:A").Find(what:=cbproduit.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not R Is Nothing Then trouve = True
     
     For Each R In ThisWorkbook.Sheets("primaire").Range("A65536:A" & ThisWorkbook.Sheets("primaire").Range("A:A").End(xlDown).Row)
       If R.Text = cbproduit.Value Then
          Workbooks.Open Racine & "modele_fiche_suiveuse.xlsx"
                           
          With ThisWorkbook.Sheets("primaire")
             occurence = 0
             Range("C5").Value = .Range("D" & R.Row).Value
             Range("C6").Value = .Range("C" & R.Row).Value
             Range("G5").Value = .Range("A" & R.Row).Value
             Range("G6").Value = .Range("P" & R.Row).Value
             Range("G7").Value = .Range("I" & R.Row).Value
             Range("A10").Value = .Range("AJ" & R.Row).Value
             Range("B10").Value = .Range("J" & R.Row).Value
             Range("C10").Value = .Range("K" & R.Row).Value
             Range("D10").Value = .Range("R" & R.Row).Value
             Range("E10").Value = .Range("T" & R.Row).Value
             Range("F10").Value = .Range("S" & R.Row).Value
             Range("G10").Value = utilisation
          End With
                 
       End If
     Next R
     occurence = 0
    End If
     
    chr = Range("format!G5")
    chr1 = Range("format!C5")

    ChDrive "c"
    ChDir Racine
    If Dir(Racine & chr & "_" & chr1 & ".xlsx") = "" Then
      ActiveWorkbook.SaveAs Filename:=chr & "_" & chr1
     Else
      MsgBox "Fichier " & chr & "_" & chr1 & " Déjà présent"
    End If

question = MsgBox("voulez vous visualiser la fiche suiveuse ?", vbYesNo + vbQuestion, " Suggestion ")
If question = vbYes Then
  Workbooks.Open Racine & chr & "_" & chr1 & ".xlsx"
 Else
  ActiveWorkbook.Close
End If
Unload fiche_suivi
End Sub
 
Vote positif 0 Vote négatif
P

PEX

XLDnaute Occasionnel
Re : verifier presence fichier avant enregistrement

camarchepas à dit:
Bonjour,

J'ai revu l'ensemble de cette portion de code, pas de chose dramatique mais si jamais ça peut faire avancer le schmilblick ....

Et j'ai rajouté le test d'existence du fichier et un message d'information.

Code: 
Private Sub save_Click()

    Dim X As Integer, occurence As Integer
    Dim R As Range
    Dim ligne As Long
    Dim trouve As Boolean 'déclare la variable trouvé
    Dim chr As String, chr1 As String
    Dim question As Long
    Dim Racine As String
    
    If cbproduit = "" Then
      question = MsgBox("Entrer un nom Produit !", vbCritical, "Information Manquante")
    End If
 
    Racine = "C:\Documents and Settings\s558670\Bureau\"
    trouve = False
    occurence = 0
    ligne = 1
    Label_Alerte = ""
               
    '=======================================================
    'Recherche les produits parmi les primaires
    '=======================================================
    
    Set R = ThisWorkbook.Sheets("primaire").Range("A:A").Find(what:=cbproduit.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not R Is Nothing Then trouve = True
     
     For Each R In ThisWorkbook.Sheets("primaire").Range("A65536:A" & ThisWorkbook.Sheets("primaire").Range("A:A").End(xlDown).Row)
       If R.Text = cbproduit.Value Then
          Workbooks.Open Racine & "modele_fiche_suiveuse.xlsx"
                           
          With ThisWorkbook.Sheets("primaire")
             occurence = 0
             Range("C5").Value = .Range("D" & R.Row).Value
             Range("C6").Value = .Range("C" & R.Row).Value
             Range("G5").Value = .Range("A" & R.Row).Value
             Range("G6").Value = .Range("P" & R.Row).Value
             Range("G7").Value = .Range("I" & R.Row).Value
             Range("A10").Value = .Range("AJ" & R.Row).Value
             Range("B10").Value = .Range("J" & R.Row).Value
             Range("C10").Value = .Range("K" & R.Row).Value
             Range("D10").Value = .Range("R" & R.Row).Value
             Range("E10").Value = .Range("T" & R.Row).Value
             Range("F10").Value = .Range("S" & R.Row).Value
             Range("G10").Value = utilisation
          End With
                 
       End If
     Next R
     occurence = 0
    End If
     
    chr = Range("format!G5")
    chr1 = Range("format!C5")

    ChDrive "c"
    ChDir Racine
    If Dir(Racine & chr & "_" & chr1 & ".xlsx") = "" Then
      ActiveWorkbook.SaveAs Filename:=chr & "_" & chr1
     Else
      MsgBox "Fichier " & chr & "_" & chr1 & " Déjà présent"
    End If

question = MsgBox("voulez vous visualiser la fiche suiveuse ?", vbYesNo + vbQuestion, " Suggestion ")
If question = vbYes Then
  Workbooks.Open Racine & chr & "_" & chr1 & ".xlsx"
 Else
  ActiveWorkbook.Close
End If
Unload fiche_suivi
End Sub
Cliquez pour agrandir...


Un tres tres grand merci a toi !

j'ai adapter un peu car si j'utilisait ton code tel quel j'avais des erreurs ;(.

Par contre j'aurai voulu savoir pour un enregistrement sur un serveur, on m'a parler d'integrer une commande "SHELL" mais n'est ce pas un peu lourd pour une macro Excel ? Le souci est qu'a chauqe fois je dois monter un lecteur virtuel a partir de mon adresser de dossier sur le serveur ...

existe-t-il une parade ?

cordialement

Adrien
 
Vote positif 0 Vote négatif

Discussions similaires

yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
162
Dranreb
Dranreb
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
114
sebastien176
S
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
281
Dranreb
Dranreb
Regueiro
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
296
sylvanu
sylvanu
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
932
thivame
T
M
  • Question
Microsoft 365 modifier un code
Réponses
1
Affichages
247
Dranreb
Dranreb
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
470
Phil69970
Phil69970
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
344
dadu35
D
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
240
halecs93
halecs93
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
235
florian50470
F

Membres actuellement en ligne

12 membres et 141 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 223
Messages
2 086 407
Membres
103 201
dernier inscrit
centrale vet