Macro VBA : Problème avec SaveAs Worksheet en .txt format MS-DOS

**SpaceX** · 13/09/2018, 09h26

Bonjour,

Je n'arrive pas à résoudre un problème que j'ai depuis plusieurs jours et je ne trouve aucune solution sur internet.

Je souhaite que ma macro enregistre une feuille de mon classeur au format texte (FileFormat:=xlTextMSDOS) sans fermer mon classeur actif (et en fermant le fichier texte créé).

Cependant lorsque j'exécute ma macro je rencontre plusieurs problèmes majeurs :

- Je génère bien un fichier texte au format MS-DOS et d'extension .BAT mais je ne peux pas l'ouvrir (en mode modifier) pour visualiser le contenu, sa me fait : "ACXXX.bat (Ne répond pas)".

- Quand je double clique sur le fichier généré, sa me fait ce message d'erreur :
"Ce fichier est utilisé par une autre application"

- Enfin, mon classeur excel qui s'appelle reprise_taille.xlsm change de nom avec celui du fichier crée : ACXXX.bat

Voici mon bout de code VBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Sub CommandButton1_Click()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim n As String 'déclare la variable N (Nom)
Dim pathfile As String
Set OS = Worksheets("Feuil2") 'définit l'onglet source OS (à adapter à ton cas)
Set OD = Worksheets("Feuil3") 'définit l'onglet destination OD (à adapter à ton cas)
Set R = OS.Columns(5).Find(">limite", , xlValues, xlWhole) 'définit la recherche R (recherche les occurrences de ">seuil" dans la colonne 5 (=E) de l'onglet source OS
    If Not R Is Nothing Then 'condition : s'il existe au moins une occurrence
    PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
    Do 'exécute
        'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet destination OD)
        If OD.Range("A1").Value = "" Then Set DEST = OD.Range("D1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 3)
        DEST.Value = Mid(OS.Cells(R.Row, 1).Value, 3) 'récupère les numéros de R
        DEST.Offset(0, -3) = "taille"
        DEST.Offset(0, -2) = "enfants"
        DEST.Offset(0, -1) = 0
        DEST.Offset(0, 1).Value = Mid(OS.Cells(R.Row, 2), 3) 'récupère les numéros de T
        n = OS.Cells(R.Row, 1).End(xlUp).Value 'récupère le nom
        n = Left(n, Len(n) - 4) 'enlève l'extension
        DEST.Offset(0, 3).Value = n 'récupère le nom
        Select Case Right(n, 3)
        Case Is = "T1"
            DEST.Offset(0, 2) = 600
        Case Is = "T2"
            DEST.Offset(0, 2) = 800
        Case Is = "T3"
            DEST.Offset(0, 2) = 900
        Case Is = "T4"
            DEST.Offset(0, 2) = 1000
        Case Is = "T5"
            DEST.Offset(0, 2) = 1200
        End Select
        Set R = OS.Columns(5).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
    Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
    End If 'fin de la condition
 
pathfile = ThisWorkbook.path & "\"
Worksheets("Feuil3").SaveAs FileName:=pathfile & "ACXXX.bat", _
FileFormat:=xlTextMSDOS, CreateBackup:=False
End Sub

pouvez vous m'aider svp ? je suis complètement désespéré. Merci.

Invité · 13/09/2018, 10h09

bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Sub test()
ActiveSheet.UsedRange.Copy
SaveAsDos "C:\MyRep\toto.bat", PressePapier
End Sub
Sub SaveAsDos(F As String, T As String)
With CreateObject("ADODB.Stream")
    .Charset = "ASCII"
    .Open
    .WriteText T
    .SaveToFile F
    .Close
End With
End Sub
 
 
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

**SpaceX** · 13/09/2018, 10h19

Envoyé par dysorthographie

bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Sub test()
ActiveSheet.UsedRange.Copy
SaveAsDos "C:\MyRep\toto.bat", PressePapier
End Sub
Sub SaveAsDos(F As String, T As String)
With CreateObject("ADODB.Stream")
    .Charset = "ASCII"
    .Open
    .WriteText T
    .SaveToFile F
    .Close
End With
End Sub
 
 
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

Bonjour,

j'ai adapté ton code par rapport au mien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Worksheets("Feuil3").UsedRange.Copy
SaveAsDos ThisWorkbook.path & "\ACXXX.bat", PressePapier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub SaveAsDos(F As String, T As String)
With CreateObject("ADODB.Stream")
    .Charset = "ASCII"
    .Open
    .WriteText T
    .SaveToFile F
    .Close
End With
End Sub


	
	Code  :
	Sélectionner tout -
	Visualiser dans une fenêtre à part
	123456789101112 Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

Sa m'affiche impossible d'écrire dans le fichier, sa bloque dans la procédure Sub SaveAsDos

**Menhir** · 13/09/2018, 10h19

Envoyé par SpaceX

- Je génère bien un fichier texte au format MS-DOS et d'extension .BAT mais je ne peux pas l'ouvrir (en mode modifier) pour visualiser le contenu, sa me fait : "ACXXX.bat (Ne répond pas)".

- Quand je double clique sur le fichier généré, sa me fait ce message d'erreur :
"Ce fichier est utilisé par une autre application"

- Enfin, mon classeur excel qui s'appelle reprise_taille.xlsm change de nom avec celui du fichier crée : ACXXX.bat

Pour le système, l’extension .BAT désigne les fichier "batch" permettant d'enchainer des commandes DOS.
En bref, c'est un type de fichier qui s'exécute.
Donc, si tu double-clique dessus ou si tu fais clic droit + ouvrir, il va tenter de s'exécuter et non pas de présenter son contenu.
Si tu veux l'ouvrir, il faut le faire glisser le le Notepad ou faire "Ouvrir avec..." et désigner le Notepad (ou autre éditeur de texte).

Je souhaite que ma macro enregistre une feuille de mon classeur au format texte (FileFormat:=xlTextMSDOS) sans fermer mon classeur actif (et en fermant le fichier texte créé).

Remplace ta ligne SaveAs par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim WBSource As Workbook
Set WBSource = ActiveWorkbook
Worksheets("Feuil3").Copy
ActiveWorkbook.SaveAs FileName:=pathfile & "ACXXX.bat", FileFormat:=xlTextMSDOS
ActiveWorkbook.Close
WBSource.Activate

Invité · 13/09/2018, 10h38

exacte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Sub test()
ActiveSheet.UsedRange.Copy
SaveAsDos Environ("TEMP") & "\toto.bat", PressePapier
Shell Environ("TEMP") & "\toto.bat"
End Sub
Sub SaveAsDos(F As String, T As String)
If Dir(F) <> "" Then Kill F
With CreateObject("ADODB.Stream")
    .Charset = "ASCII"
    .Open
    .WriteText T
    .SaveToFile F
    .Close
End With
End Sub
 
 
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

**SpaceX** · 13/09/2018, 11h03

Bonjour,

Merci, sa génère bien le fichier .bat, mais impossible de visualiser le contenu.

- J'ai essayé d'ouvrir bloc note, puis ouvrir à partir de la plateforme mais rien n'y fait.

- Et en faisant clic droit + modifier.

j'ai ce message d'erreur qui reviens tout le temps :

Nom : bug.png
Affichages : 380
Taille : 24,1 Ko

Nom : bug.png
Affichages : 380
Taille : 24,1 Ko

Invité · 13/09/2018, 11h35

Tu copy toute la feile3 c'est énorme !
sheets("feuille3").usedrange.copy

**SpaceX** · 13/09/2018, 11h58

Envoyé par dysorthographie

Tu copy toute la feile3 c'est énorme !
sheets("feuille3").usedrange.copy

Même en utilisant cette ligne d'insturction, je ne peux pas lire le contenu du fichier généré ....

Invité · 13/09/2018, 12h33

je ne sais que dire car ça marche chez moi!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Sub test()
Set wS = Sheets.Add
wS.Range("A1") = "notepad2.exe " & Environ("TEMP") & "\toto.bat"
wS.UsedRange.Copy
SaveAsDos Environ("TEMP") & "\toto.bat", PressePapier
Shell Environ("TEMP") & "\toto.bat"
End Sub
Sub SaveAsDos(F As String, T As String)
If Dir(F) <> "" Then Kill F
With CreateObject("ADODB.Stream")
    .Charset = "ASCII"
    .Open
    .WriteText T
    .SaveToFile F
    .Close
End With
End Sub
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

**SpaceX** · 13/09/2018, 13h10

Envoyé par dysorthographie

je ne sais que dire car ça marche chez moi!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Sub test()
Set wS = Sheets.Add
wS.Range("A1") = "notepad2.exe " & Environ("TEMP") & "\toto.bat"
wS.UsedRange.Copy
SaveAsDos Environ("TEMP") & "\toto.bat", PressePapier
Shell Environ("TEMP") & "\toto.bat"
End Sub
Sub SaveAsDos(F As String, T As String)
If Dir(F) <> "" Then Kill F
With CreateObject("ADODB.Stream")
    .Charset = "ASCII"
    .Open
    .WriteText T
    .SaveToFile F
    .Close
End With
End Sub
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

Je ne comprend plus rien, pouvez-vous s'il vous plait accorder votre code par rapport au mien ?

En utilisant votre code, j'ai un argument ou appel de procédure inconnue à cette ligne d'instruction : Shell Environ("TEMP") & "\toto.bat"

**Pierre Fauconnier** · 13/09/2018, 15h02

Envoyé par SpaceX

Bonjour,

Merci, sa génère bien le fichier .bat, mais impossible de visualiser le contenu.

- J'ai essayé d'ouvrir bloc note, puis ouvrir à partir de la plateforme mais rien n'y fait.

- Et en faisant clic droit + modifier.

j'ai ce message d'erreur qui reviens tout le temps :

cfr la remarque de Menhir. Ca n'a pas de sens, de créer un fichiet .BAT s'il ne contient pas des commandes DOS. Donne-lui une autre extension!

**SpaceX** · 13/09/2018, 16h25

C'est bon je pense avoir compris le problème !!!!!

Enfaite le fichier que je génère fait 40 Mo... ce qui est énorme ! Dans mon cas il doit contenir au maximum 15 lignes (à peu près 400 octet).

Pour résumer le code que vous m'avez fourni, grosso modo sa sélectionne TOUTES les lignes et colonnes de la feuille en question soit près de 200 000 lignes et encore sans compter les tabulations. Et donc c'est pour cela que je ne peux pas visualiser le contenu de mon fichier...

Pour palier à ce problème j'ai tenté d'effectuer un range de mes données :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Dim PP As New DataObject
    Dim MaPlage As Range
    Dim Dossier As String
    Dim Fichier As String
    Dim Texte As String
 
    Dossier = ThisWorkbook.path & "\"   
    Fichier = "Test.txt"
 
    On Error Resume Next
    Kill Dossier & Fichier
    On Error GoTo 0
 
    'Set MaPlage = Worksheets("Feuil3").UsedRange
    Set MaPlage = Range("A1").End(xlDown).Row
 
    MaPlage.Copy
 
    With PP
        .Clear
        .GetFromClipboard
        Texte = .GetText(1)
    End With
 
    Application.CutCopyMode = False
 
    'création du fichier
    Open Dossier & Fichier For Binary Access Write As #1: Put #1, , Texte: Close #1

En rajoutant ce bout de code cela m'a permis de passer de 40 Mo à 20 Mo yahouuuu ! Mais je ne peux toujours pas visualiser le contenu de mon fichier car trop gros.

Y a t-il une instruction qui permet de sélectionner un ensemble de données jusqu'à la fin de la ligne et de la colonne (sous forme de carré) ?

**pijaku** · 14/09/2018, 14h04

Bonjour,

Si tu n'as pas d'erreur, c'est que tu ne nous dis pas tout.
Montre nous le code complet utilisé.

Ceci, sans déclenchement d'erreur, est impossible :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Dim MaPlage As Range
'...
Set MaPlage = Range("A1").End(xlDown).Row

**Menhir** · 14/09/2018, 15h00

Envoyé par pijaku

Si tu n'as pas d'erreur, c'est que tu ne nous dis pas tout.

Comportement habituel de Space X qui m'incite à ne plus répondre à ses demandes.

Macro VBA : Problème avec SaveAs Worksheet en .txt format MS-DOS [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager