Gestion d'erreurs de fichier non trouvés

[jlp035]

Bonjour,
merci de jeter un oeil au petit morceau de programme ci dessous et de m'indiquer eventuellement les solutions ou pistes à mes 2 problemes identfier avec ''.
Merci par avances Jean-Luc

Sub CopieFeuilleDocuments()
     '
    Dim Std As String ' Liste de nom fichier Document
    Dim Crd As String
    Dim Soc As String
    Dim The As String
    Dim Fic As String
    Dim Message As String
   '
    Crd = Range("AA5") ' Chemin du repertoire Documents
    Soc = Range("O11") ' Nom Sociètè
    The = Range("B21") ' Thème
    Fic = Range("AA1") ' Fichier logiciel
    '
    ' copie de la zone à recopier
    Range("A56").Select
    Sheets("Documents").Select
    Sheets("Documents").Copy
      '
      ' Cases à vider
    Range("Y1:AA5").Select
    Range("Y5").Activate
    Selection.ClearContents
    
    Std = Crd & "\" & Soc & "  " & Format(Date, "yyyy_mm_dd") & "  " & Format(Time, "hh_mm") & "  " & The & ".xls"
            
        ActiveWorkbook.SaveAs Filename:= _
        Std, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

     '' Je n'ai pas trouvé la solution  car je souhaiterai avec un message d'erreur non bloquant si Std est introuvable
     '' message d'erreur qui ne fonctionne pas à revoir
        If Err Then MsgBox "Le fichier " & Std & " est introuvable...": End
        
        MsgBox "la feuille à ètè copièe dans le fichier documents :" & vbCrLf & Std
            
        ActiveWorkbook.Close

      '' Je n'ai pas trouvé la solution  car je souhaiterai que " 2012_01_19 documents(dev3).xls" soit remplcé par 
      ''le contenu de la cellule AA1 de la feuille Documents.
        Windows("2012_01_19 documents(dev3).xls").Activate

        Sheets("Documents").Select
        ActiveWindow.SmallScroll Down:=-35
      
  End Sub

 

[Compte Supprimé 979]

Re : Gestion d'erreurs de fichier non trouvés

Bonsoir jlp035

Regarde avec ceci

Option Explicit
Sub CopieFeuilleDocuments()
'
  Dim Std As String  ' Liste de nom fichier Document
  Dim Crd As String
  Dim Soc As String
  Dim The As String
  Dim Fic As String
  Dim Message As String
  '
  Crd = Range("AA5")  ' Chemin du repertoire Documents
  Soc = Range("O11")  ' Nom Sociètè
  The = Range("B21")  ' Thème
  Fic = Range("AA1")  ' Fichier logiciel
  '
  ' copie de la zone à recopier => HEUUU étrange ton code, pour moi ça ne fait rien de spécial
  Range("A56").Select
  Sheets("Documents").Select
  Sheets("Documents").Copy
  '
  ' Cases à vider
  Range("Y5").ClearContents
  Range("Y1:AA5").Select
  Std = Crd & "\" & Soc & "  " & Format(Date, "yyyy_mm_dd") & "  " & Format(Time, "hh_mm") & "  " & The & ".xls"
  
  ' En cas d'erreur on continue la procédure
  On Error Resume Next
  '
  ActiveWorkbook.SaveAs Filename:=Std
  ' Pas nécessaire
  ', FileFormat:=xlNormal, _
                        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                        CreateBackup:=False
  '' Je n'ai pas trouvé la solution  car je souhaiterai avec un message d'erreur non bloquant si Std est introuvable
  '' message d'erreur qui ne fonctionne pas à revoir
  If Err.Number <> 0 Then
    MsgBox "Le fichier " & Std & " est introuvable..."
    Exit Sub
  End If
  MsgBox "la feuille à ètè copièe dans le fichier documents :" & vbCrLf & Std
  ActiveWorkbook.Close
  '' Je n'ai pas trouvé la solution  car je souhaiterai que " 2012_01_19 documents(dev3).xls" soit remplcé par
  ''le contenu de la cellule AA1 de la feuille Documents.
  ' JE NE COMPRENDS PAS TROP LA QUESTION !?
  Windows("2012_01_19 documents(dev3).xls").Activate
  Sheets("Documents").Select
  ActiveWindow.SmallScroll Down:=-35
End Sub

Je ne comprends pas ce que tu veux faire au début de ton code

 ' copie de la zone à recopier => HEUUU étrange ton code, pour moi ça ne fait rien de spécial
  Range("A56").Select
  Sheets("Documents").Select
  Sheets("Documents").Copy

Et je ne comprends pas la question

'' Je n'ai pas trouvé la solution  car je souhaiterai que " 2012_01_19 documents(dev3).xls" soit remplcé par
  ''le contenu de la cellule AA1 de la feuille Documents.
  ' JE NE COMPRENDS PAS TROP LA QUESTION !?
  Windows("2012_01_19 documents(dev3).xls").Activate
  Sheets("Documents").Select

A+

 

[jlp035]

Bonjour,
apres recherche sur le forum et reflexion , j'ai trouvée une solution.
Je remercie egalement BrunoM45.
ci joint copie du code

Sub CopieFeuilleDocuments()
   '
   Dim Std As String  ' Liste de nom fichier Document
   Dim Crd As String
   Dim Soc As String
   Dim The As String
   Dim Fic As String
   Dim Message As String
   '
   Crd = Range("AA5")  ' Chemin du repertoire Documents
   Soc = Range("O11")  ' Nom Sociètè
   The = Range("B21")  ' Thème
   Fic = Range("AA1")  ' Fichier logiciel
   '
 If Dir$(Crd) = "" Then
   ' copie de la zone à recopier
   Range("A56").Select
   Sheets("Documents").Select
   Sheets("Documents").Copy
   ' Cases à vider
   Range("Y1:AA5").Select
   Range("Y5").Activate
   Selection.ClearContents
   ' Chemin du fichier copier
   Std = Crd & "\" & Soc & "  " & Format(Date, "yyyy_mm_dd") & "  " & Format(Time, "hh_mm") & "  " & The & ".xls"
   ActiveWorkbook.SaveAs Filename:=Std
   MsgBox "la feuille à ètè copièe dans le fichier documents destinataires:" & vbCrLf & Std
   ActiveWorkbook.Close
     Else
   MsgBox " Le fichier" & Crd & " est introuvable ?" & vbCrLf & " Vérifier le chemin du fichier  :" & vbCrLf & "documents du destinataire."
     End If
    Windows(Fic).Activate
    Sheets("Documents").Select
    ActiveWindow.SmallScroll Down:=-35
  End Sub

Cordialement Jean-Luc