enregistrer fichiers sauf l'actif

**friteurs** · 12/01/2011, 09h47

Alors déjà un grand bonjour, je suis nouveau sur ce forum.

J'ai un problème avec une macro. J'ai créé une macro pour enregistrer et fermer tout les fichier sauf l'actif. Elle doit enregistrer le fichier sous le nom chemin que je rentre, texte rentré dans la cellule G10 et en xlsx. Celle-ci marchait très bien fin décembre et maintenant elle ne fonctionne plus. Je me demande si la mise à jour microsoft ne poserait pas problème.
Si quelqu'un peut m'apporter ses lumières. Voici ma macro:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim chemin As String
Dim classeur As workbooks
 
chemin = InputBox("entrer dossier .xls \ à la fin:")
 
For Each classeur In Workbooks                                     
    If classeur.Name <> ThisWorkbook.Name Then
       classeur.SaveAs Filename:=chemin _
       & Range("G10").Value & ".xlsx", FileFormat _
       :=xlOpenXMLWorkbook, Password:="",WriteResPassword:="",_               ReadOnlyRecommended:= False, CreateBackup:=False                               
    classeur.Close
     End If
Next classeur

Merci d'avance

**casefayere** · 12/01/2011, 10h50

Bonjour,
je ne sais pas si ça vient de là mais la déclaration de classeur, à mon avis ne convient pas

Code :

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

Dim classeur As Workbook

à la place de

Code :

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

Dim classeur As Workbooks

sous reserve.....

si ton chemin est en G10, pourquoi pas

Code :

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

chemin = range("g10")

bonne journée

**friteurs** · 12/01/2011, 12h17

Non j'ai testé ça ne marche pas.

En faite avant cette partie de macro, j'ouvre plusieurs fichiers txt en fichier excel. j'écris ensuite le nom du fichier ouvert sans l'extension txt en G10.
Ensuite je veux enregistrer tout ces fichiers ouvert dans un dossier (d'où le chemin) avec le nom inscrit dans la cellule G10 en xlsx.

La macro est longue donc je vous épargne tout ça, mon problème est que maintenant seul un fichier s'enregistre, mais tous se ferme. Il doit y avoir un problème sur l'enregistrement dans ma macro.

**casefayere** · 12/01/2011, 12h46

d'où ma premiere remarque,

Code :

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

Dim classeur As Workbook

et non "workbooks"
si tous les classeurs se ferment, pas sur, mais......

**Godzestla** · 12/01/2011, 13h39

Bonjour,

au cas ou Casefayere n'a pas résolu ton problème, il serait utile d'expliquer ce que tu entends par

Celle-ci marchait très bien fin décembre et maintenant elle ne fonctionne plus

**friteurs** · 12/01/2011, 17h40

Ce que je voulais dire par là c'est que quand j'ai testé cette macro fin décembre ma macro marchait parfaitement. Les fichiers ouvert s'enregistraient chacun sous le nom qui leur étaient attribués et se fermaient ensuite. Maintenant l'enregistrement pose problème.
Merci casefayere j'ai testé ce que tu m'as dis mais ça ne marche pas.

**Godzestla** · 12/01/2011, 17h48

Re,

sur ce forum, pour être efficacement aidé , il faut parler avec précision.

Tu écris ceci :

Maintenant l'enregistrement pose problème.

Quel problème ? Une erreur ? laquelle? Quelle ligne de code ? Tu as essayé le debug.... ?

Sur base de tes explications, on peut poser 1000 questions.

As tu testé ce que contient

Code :

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

1
2
Filename:=chemin _
       & Range("G10").Value & ".xlsx"

N'est ce pas simplement la source du problème ?

**friteurs** · 14/01/2011, 16h02

oui j'ai tester dans une msgbox et il n'y a aucun soucis. Pour plus de précision mon problème se situe lors de l'enregistrement. Lorsque la macro démarre, tout les fichier s'enregistre et se ferme, mais le fichier s'écrase à chaque fois ou un seul fichier s'enregistre je ne sais pas. Mais au final il n'y a qu'un seul fichier.

**Godzestla** · 19/01/2011, 17h30

Bonjour,

a la relecture de ton code, il me parait normal et évident que tous tes savesas se font sur le nom unique contenu en "G10" et que donc tu as 1 seul fichier sauvé en finalité : le dernier.

**friteurs** · 24/01/2011, 18h16

Dans la cellule G10, j'ecrit une formule qui m'ecrit automatiquement le nom du fichier qui s'ouvre. Donc chaque fichier ouvert a un nom propre. Il devrait donc y avoir autant d'enregistrement que de fichier ouvert. J'ai meme teste de copier coller cet case ensuite afin que le nom reste inchanger par la suite.
Je vais vous donner mon code de debut de macro (il est un peu long desole):

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Sub a_Mode_Diff_Single()
 
Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range
Dim file As String
Dim foules As String
Dim Fichier As String, Chemin As String
Dim Wb As Workbook
Dim Mode As String
Dim SrcBook As Workbook
Dim fso As Object, f As Object, ff As Object, f1 As Object
Dim far As String
Dim Maximum As String
Dim Minimum As String
Dim Image As Variant
Dim choose As String
 
 
Application.ScreenUpdating = False
far = InputBox("...")
file = InputBox("...")
foules = InputBox("entrer dossier .xls \ à la fin:")
choose = InputBox("Nom du fichier à créer (créer dans le dossier des fichier .txt):")
 
 
 
myPath = file                                   'CONVERSION TXT ==> XLSX
If myPath = "" Then Exit Sub
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
 
myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.txt")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If
 
Set DestCell = Workbooks.Add(1).Worksheets(1).Range("a1")
 
 
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop
 
If fCtr > 0 Then
If fCtr > DestCell.Parent.Columns.Count Then
MsgBox "too many files!"
Exit Sub
End If
For fCtr = LBound(myNames) To UBound(myNames)
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
 
Workbooks.OpenText Filename:=myPath & myNames(fCtr), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, _
Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
 
Set wks = ActiveSheet                           'TRAITEMENT FEUILLE
    ActiveSheet.Select
    ActiveSheet.Name = "1"
 
 
Range("G10:J10").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("G10:J10").Select
    ActiveCell.FormulaR1C1 = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-5)"      'Formule nom du fichier ouvert
 
Next fCtr
End If
Application.DisplayAlerts = False
 
 
For Each classeur In Workbooks                                      'ENREGISTREMENT FICHIERS
If classeur.Name <> ThisWorkbook.Name Then
    classeur.SaveAs Filename:=foules _
    & Range("G10").Value & ".xlsx", FileFormat _
    :=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
    False, CreateBackup:=False                                  'change le fichier de sauvegarde, CTRL+F pour changer.
    classeur.Close
End If
Next classeur
Application.DisplayAlerts = True
 
With Application
.ScreenUpdating = True
.StatusBar = False
End With
 
End sub

**Godzestla** · 24/01/2011, 18h22

Bonsoir,

2 remarques :

1) Sans laes balises code ton code est illisible.

2) je persiste et signe : Tu fais une boucle dans laquelle tu utilise chaque fois la même cellule DU MEME FICHIER comme nom de sauvegarde de ton fichier. Donc tu écrases chaque fois ta sauvegarde précédente. Si G10 est dans le classeur à sauver, ce n'est pas celle-là que tu utilises.

Si j'ai bien deviné, voici la partie de ton code à changer :

Code :

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

1
2
3
4
5
6
7
8
9
For Each classeur In Workbooks 'ENREGISTREMENT FICHIERS
If classeur.Name <> ThisWorkbook.Name Then
classeur.SaveAs Filename:=foules _
& Classeur.Range("G10").Value & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False 'change le fichier de sauvegarde, CTRL+F pour changer.
classeur.Close
End If
Next classeur

Mais attention, il manque après classeur le nom de la feuille ou se trouve G10, et cela ma boule de cristal a refusé de me le communiquer.

**Qwazerty** · 24/01/2011, 21h57

Salut
Je pense que le derniere message de Godz va répondre a ton besoin. Moi j'attirerais plus ton attention sur ta syntaxe

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
Set wks = ActiveSheet 'TRAITEMENT FEUILLE
ActiveSheet.Select
ActiveSheet.Name = "1"
 
 
Range("G10:J10").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("G10:J10").Select
ActiveCell.FormulaR1C1 = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-5)" 'Formule nom du fichier ouvert

En effet lorsque tu travailles avec plusieurs fichiers, il est très important de bien définir sur lequel tu travailles. Je pense que c'est une mauvaise idée que d'utiliser des Range ou Cells sans definir à quelle feuille de quel classeur ils appartiennent. Lorsque tu fais ça, tu estimes que le fichier actif est bien celui sur lequel tu veux travailler. A mon avis c'est la loterie et c'est très risqué

Il serait plus propre et surtout moins risqué d'utiliser ce type de structure.

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
Set wks = ActiveSheet 'TRAITEMENT FEUILLE
'Pourquoi ne pas l'utiliser par la suite??
'ActiveSheet.Select 'inutile
 
With wks
    .Name = "1"
    With .Range("G10:J10")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
        .FormulaR1C1 = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-5)" 'Formule nom du fichier ouvert
    End With
End With

++
Qwaz

**friteurs** · 25/01/2011, 16h44

Merci j'ai modifie ce que tu m'a dis qwazerty, mon programme marche! Merci encore a vous 2, et desole pour le temps entre chacune de mes reponse mais je suis pas trop disponible ces temps ci. En tout cas cette macro va bien m'aider.
Et bien sur merci a tout ce qui reponde sur tout autre forum!

enregistrer fichiers sauf l'actif [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager