Eviter un message d'erreur

[degap05]

Bonjour,

Le fichier joint, réalisé avec l'aide du forum, permet de copier des données dans le bloc note et à sauvegarder le fichier créé dans le dossier C:\temp (s'assurer qu'il existe pour l'essai).
Pour sélectionner les lignes à copier, il faut d'abord double-cliquer en colonne D.
Ensuite actionner le bouton.
Jusque là tout fonctionne bien.
Si j'actionne une seconde fois le bouton, j'ai un message qui me signale qu'un fichier est déjà présent en C:\temp et me propose soit de l'écraser, Non ou Annuler.
Si je l'écrase pas de problème. Mais si je répond Non ou annuler j'ai un message d'erreur VBA. C'est ce message que je cherche à éliminer. Malgré de nombreux essais, je n'y suis pas parvenu.

Avec votre aide.
Merci.

 

[GiHesse]

Re : Eviter un message d'erreur

Bonjour,

je n'ai pas regardé votre fichier joint, mais avez vous essayé :


'On désactive les alertes temporairement
Application.DisplayAlerts = False


'Le Code posant probleme


'On réactive les alertes
Application.DisplayAlerts = True

Cdt, GiHesse

 

[degap05]

Re : Eviter un message d'erreur

Bonjour,

je n'ai pas regardé votre fichier joint, mais avez vous essayé :


'On désactive les alertes temporairement
Application.DisplayAlerts = False


'Le Code posant probleme


'On réactive les alertes
Application.DisplayAlerts = True

Cdt, GiHesse

Bonjour GiHesse,

J'avais essayé cette option. Dans ce cas là, pas de message d'alerte VBA et la macro se déroule, ne laissant pas le choix d'abandonner la transaction si un fichier existe déjà.

Merci.

 

[degap05]

Re : Eviter un message d'erreur

Bonjour à tous
je te propose dans ta gestions d'erreurs de déplacer d'une ligne vers le bas le on error goto 0

( après l'enregistrement)

dans la macro de copieBlocNote
a test
salut

Bonjour Jean-Marcel,

J'avais essayé cette possibilité, effectivement plus de message d'alerte VBA, la macro se déroule, ne laissant pas le choix d'abandonner la transaction si un fichier existe déjà.

Merci.

 

[Minick]

Re : Eviter un message d'erreur

Salut,

Change la macro CopieBlocNote comme ceci:

Sub CopieBlocNote()
    [B]Dim fs[/B]
    [B]Dim EcrireFichier As Boolean[/B]
    Dim WkDat As Workbook
    Application.ScreenUpdating = False
    Set WkDat = Workbooks.Add
    With ThisWorkbook.Sheets(1)
         .Range("L2").FormulaR1C1 = "=RC[-11]&""00""&RC[-10]&REPT("" "",18-LEN(RC[-10]))&TEXT(RC[-9],""00000000"")&""     ""&RC[-8]&REPT("" "",113-LEN(RC[-8]))&RC[-7]&REPT("" "",11-LEN(RC[-7]))" _
                                    & "&RC[-6]&REPT("" "",11-LEN(RC[-6]))&MID(RC[-5],1,40)&REPT("" "",40-LEN(MID(RC[-5],1,40)))&RC[-4]&REPT("" "",12-LEN(RC[-4]))" _
                                    & "&RC[-3]&REPT("" "",20-LEN(RC[-3]))&RC[-2]&REPT("" "",7-LEN(RC[-2]))&RC[-1]&REPT("" "",16-LEN(RC[-1]))"
        With .Range("L2:L" & .Range("A65536").End(xlUp).Row)
            If ThisWorkbook.Sheets(1).Range("G3") <> "" Then .FillDown
                '.FillDown
                .Calculate
                .Copy
                WkDat.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
                .ClearContents
        End With
        
[B]         EcrireFichier = True
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.fileexists("C:\temp" & "\" & .Range("A1").Value & ".txt") Then
            If MsgBox("Le Fichier 'C:\temp" & "\" & .Range("A1").Value & ".txt' existe deja." & vbCrLf & "Vouslez-vous l'écraser?", vbYesNo) = vbYes Then
                Kill "C:\temp" & "\" & .Range("A1").Value & ".txt"
            Else
                EcrireFichier = False
            End If
        End If[/B]
        
        [B]If EcrireFichier Then[/B]
            WkDat.SaveAs Filename:="C:\temp" & "\" & .Range("A1").Value & ".txt", FileFormat:=xlText
        [B]End If[/B]
        WkDat.Close savechanges:=False
    End With
    Set WkDat = Nothing
    
End Sub

++
Minick

 

[degap05]

Re : Eviter un message d'erreur

Bonjour Minick,

Tu retrouves un fichier pour lequel tu m'as déjà beaucoup aidé
Ta solution fonctionne très bien, mais du coup le message que j'avais mis en place pour indiquer à l'utilisateur que les données avaient bien été transmises (dans le bouton 1), s'affiche même si l'on n'écrase pas le fichier.

Merci.
A+

 

[Minick]

Re : Eviter un message d'erreur

ooops j'ai pas regarde la macro du bouton...

Change comme ceci, la sub CopieBlocNote devient une fonction qui renvoie si le fichier est copie ou non.

Private Sub CommandButton1_Click()
    If Application.CountA(Range("D4:D50")) > 0 Then
        If CopieBlocNote Then
            MsgBox "Les données des lignes cochées, ont bien été transférées à Copilote"
            ThisWorkbook.Save
            Application.Quit
        End If
    Else
        MsgBox "Veuillez cocher les lignes des références à transférer à Copilote, en colonne D"
    End If
End Sub

Function CopieBlocNote() As Boolean
    Dim fs
    Dim EcrireFichier As Boolean
    Dim WkDat As Workbook
    Application.ScreenUpdating = False
    Set WkDat = Workbooks.Add
    With ThisWorkbook.Sheets(1)
         .Range("L2").FormulaR1C1 = "=RC[-11]&""00""&RC[-10]&REPT("" "",18-LEN(RC[-10]))&TEXT(RC[-9],""00000000"")&""     ""&RC[-8]&REPT("" "",113-LEN(RC[-8]))&RC[-7]&REPT("" "",11-LEN(RC[-7]))" _
                                    & "&RC[-6]&REPT("" "",11-LEN(RC[-6]))&MID(RC[-5],1,40)&REPT("" "",40-LEN(MID(RC[-5],1,40)))&RC[-4]&REPT("" "",12-LEN(RC[-4]))" _
                                    & "&RC[-3]&REPT("" "",20-LEN(RC[-3]))&RC[-2]&REPT("" "",7-LEN(RC[-2]))&RC[-1]&REPT("" "",16-LEN(RC[-1]))"
        With .Range("L2:L" & .Range("A65536").End(xlUp).Row)
            If ThisWorkbook.Sheets(1).Range("G3") <> "" Then .FillDown
                '.FillDown
                .Calculate
                .Copy
                WkDat.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
                .ClearContents
        End With
       
         EcrireFichier = True
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.fileexists("C:\temp" & "\" & .Range("A1").Value & ".txt") Then
            If MsgBox("Le Fichier 'C:\temp" & "\" & .Range("A1").Value & ".txt' existe deja." & vbCrLf & "Vouslez-vous l'écraser?", vbYesNo) = vbYes Then
                Kill "C:\temp" & "\" & .Range("A1").Value & ".txt"
            Else
                EcrireFichier = False
            End If
        End If
       
        If EcrireFichier Then
            WkDat.SaveAs Filename:="C:\temp" & "\" & .Range("A1").Value & ".txt", FileFormat:=xlText
        End If
        WkDat.Close savechanges:=False
    End With
    Set WkDat = Nothing
    CopieBlocNote = EcrireFichier
End Function

++
Minick

 

[degap05]

Re : Eviter un message d'erreur

J'essaie demain matin

Merci pour ta disponibilité.

A+

 

[degap05]

Re : Eviter un message d'erreur

Bonjour Minick,

Voilà, je viens de terminer l'adaptation de ta solution à mon fichier de travail.
Cela fonctionne parfaitement.

Merci de ton aide.

Salutations.