Annulation fenetre windows

Résolu
titi17-08 -  
Bonjour à tous,
sur mon classeur, j'ai un bouton qui a pour fonction d'ouvrir un fichier dans le répertoire Windows.
lorsque je clique sur annuler, cela m'envoie une erreur
avez vous une solution pour fermer la macro lorsque je clique sur annuler de la fenêtre Windows
je vous remercie d'avance
Titi

4 réponses

  1.  Patrice33740
    Oups, c'est sans les paranthèses 
      Workbooks.OpenText Filename:=a, DataType:=xlDelimited, Semicolon:=True
  Set wbk = ActiveWorbook
    0
    1. titi17-08 Auteur
      La ligne fonctionne,
      maintenant c'est la set cell qui beugue
      désolé (:
      0
    2. Patrice33740
      @titi17-08La feuille de destination s'appelle-t-elle Feuil1 ?
      Il faut mettre le bon nom de feuille !
      0
    3. titi17-08 Auteur
      @Patrice33740Patrice,
      cela fonctionne
      merci de votre patience...;)
      ci joint le code correctement ecrit
      encore merci
      Titi 
      Private Sub Bouton_atelier_fiche_Click()
Dim wbk As Workbook
Dim cel As Range
Dim a As Variant

  ChDir "\\Serveur-atelier\societe\TOPSOLID\PROJETS"
  a = Application.GetOpenFilename
  If a = False Then Exit Sub
  Set cel = Workbooks("FICHE SUIVI Atelier Montage.xltm").Worksheets("feuille suivi atelier").Range("A16") 'adapter nom feuille
 Workbooks.OpenText Filename:=a, DataType:=xlDelimited, Semicolon:=True
  Set wbk = ActiveWorkbook
  wbk.Worksheets(1).Range("A3:D100").Copy Destination:=cel
  wbk.Close SaveChanges:=False
  Application.Goto cel.Offset(0, 5) 'F16

End Sub
      0
  2. Patrice33740
    Re,

    Je t'avais pourtant donné un code propre !
    C'était facile de trouver la solution : 
    Private Sub Bouton_atelier_fiche_Click()
Dim wbk As Workbook
Dim cel As Range
Dim a As Variant

  ChDir "\\Serveur-atelier\societe\TOPSOLID\PROJETS"
  a = Application.GetOpenFilename
  If a = False Then Exit Sub
  Set cel = Workbooks("FICHE SUIVI Atelier Montage.xltm").Worksheets("Feuil1").Range("A16") 'adapter nom feuille
  Set wbk = Workbooks.OpenText(Filename:=a, DataType:=xlDelimited, Semicolon:=True)
  wbk.Worksheets(1).Range("A3:D100").Copy Destination:=cel
  wbk.Close SaveChanges:=False
  Application.Goto cel.Offset(0, 5) 'F16

End Sub


    Noter que :
    - une fenêtre - Windows(...) - n'est pas un classeur - Workbooks(...) !
    - il faut éviter l'emploi de Select et plus généralement de travailler sur l'objet actif
    - il faut éviter d'utiliser le presse papier (c'est à dire d'utiliser Paste).
    - il est plus simple de travailler avec des variables objets (wbk, cel)

    0
    1. titi17-08 Auteur
      Bonjour Patrice,
      Merci pour ton message et tes conseils.
      je débute dans le code, autodidacte..
      mais ton code ne fonctionne pas, cela me met un message d'erreur sur le set wbk= workbooks.open Text
      A te lire
      Bonne journée
      Titi
      0
    2. Patrice33740
      @titi17-08D'ici, j'ai du mal à lire le message d'erreur.

      Remplaces 
        Set wbk = Workbooks.OpenText(Filename:=a, DataType:=xlDelimited, Semicolon:=True)

      Par 
        Workbooks.OpenText(Filename:=a, DataType:=xlDelimited, Semicolon:=True)
  Set wbk = ActiveWorbook
      0
    3. titi17-08 Auteur
      @Patrice33740Patrice,
      mon message d'erreur est le suivant :
      et pour la modification que vous m'avez recommandé, la ligne workbooks est en ligne
      :)
      0
  3. titi17-08 Auteur
    Bonjour Patrice,
    désolé de ne pas avoir poser ma question dans la bonne forme:
    donc quand je clique sur annuler de la fenêtre Windows, j'ai une erreur.
    voici mon code
    a vous remerciant d'avance.
    cordialement
    Titi 

    Private Sub Bouton_atelier_fiche_Click()

Dim ret As String
'Determine plage plateau
ret = Application.GetOpenFilename
ChDir _
"\\Serveur-atelier\societe\TOPSOLID\PROJETS"

'ret = Application.GetOpenFilename("DAT Files (*.dat), *.dat") 'Avec Filtre sur des fichier avec extension DAT
Workbooks.Open Filename:=ret
If False Then
Workbooks.OpenText Filename:=ret, DataType:=xlDelimited, Semicolon:=True
Worksheets(1).Range("A3:D100").Select
Selection.Copy


Windows("FICHE SUIVI Atelier Montage.xltm").Activate
Range("A16").Select
ActiveSheet.Paste
Range("F16").Activate

End Sub
    0
    1. Patrice33740
      Re,

      Essaies : 
      Option Explicit
Private Sub Bouton_atelier_fiche_Click()
Dim wbk As Workbook
Dim cel As Range
Dim ret As Variant
  
  ret = Application.GetOpenFilename
  If Not ret = False Then
    'Cellule de destination
    Set cel = Workbooks("FICHE SUIVI Atelier Montage.xltm").Worksheets("Feuil1").Range("A16") 'adapter nom feuille

'Ou si c'est vers classeur qui contient la macro :
'    Set cel = ThisWorkbook.Worksheets("Feuil1").Range("A16") 'adapter nom feuille
    
    'Ouvrir le fichier des données
    Set wbk = Workbooks.Open(Filename:=ret)
    
    'Copier la plage de donnés
    wbk.Worksheets(1).Range("A3:D100").Copy Destination:=cel
    
    'Fermer le fichier ds données
    wbk.Close SaveChanges:=False
  End If
End Sub
      0
    2. titi17-08 Auteur
      @Patrice33740Patrice,
      alors ton code fonctionne bien quand je clique sur annuler, l'action est annulée
      par contre quand je choisis mon fichier a importer, rien ne se passe
      je dois peut etre mettre ton code dans mon code?
      merci de ton retour
      Titi
      0
  4. Patrice33740
    Bonjour,

    Essaies de mettre un grand miroir face ā ton écran pour qu'on puisse voir à quoi ressemble le code de ta macro. Si tu n'as pas de miroir, postes ici le code de ta macro .

    Et quand tu postes du code sur le forum ...
    Utilises les balises de code avec indication du langage (=coloration syntaxique)
    Explications disponibles ici : Comment utiliser les balises de code
    Exemple : 
    Sub UtiliserLesBalises()
  MsgBox "Merci d'utiliser les balises de code"
End Sub
    0
    1. titi17-08 Auteur
      Patrice,
      j'ai quasi tout reglé dans mon code.
      reste a fermer mon fichier de source…
      si vous pouvez m'aider
      merci 
      Private Sub Bouton_atelier_fiche_Click()
Dim ret As String
Dim wbk As Workbook
a = Application.GetOpenFilename
 If a = False Then Exit Sub

'Determine plage plateau

ChDir _
"\\Serveur-atelier\societe\TOPSOLID\PROJETS"
'ret = Application.GetOpenFilename("DAT Files (*.dat), *.dat") 'Avec Filtre sur des fichier avec extension DAT
Workbooks.Open Filename:=a
Workbooks.OpenText Filename:=a, DataType:=xlDelimited, Semicolon:=True
Worksheets(1).Range("A3:D100").Select
Selection.Copy
Windows("FICHE SUIVI Atelier Montage.xltm").Activate
Range("A16").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("F16").Activate

End Sub

      Bonne fin de journée
      Titi
      0