Bonjour,

donc j'ai une macro qui marche trés bien ci dessous en VBA Excel

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
 
Sub Fiche_def()
 
'Init Variable
Dim i As Integer
i = 1
Dim cell As String
Dim ligne_debut As Integer
Dim ligne_fin As Integer
Dim FichierCelStr As String
Dim NomFiche As String
 
'Sélection fichier exportation rbase
FichierCelStr = Application.GetOpenFilename("Excel (*.xls), *.xls", 1, "Sélectionner le Fichier d'Exportation de Rbase pour les Fiches de Défauts")
 
Workbooks.Open (FichierCelStr)
 
'Mise en forme
Columns("A:D").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
 
'Copy ver Model
Sheets("fiche_def").Select
Sheets("fiche_def").Move After:=Workbooks("MODELEv1.2.xls").Sheets(1)
 
'var active model
Set model = Worksheets("model")
'variable fichier
Dim Chemin As String
Dim NomFichier As String
Chemin = ActiveWorkbook.Path
 
'init var pour boucle
ligne_debut = 1
ligne_fin = 0
Sheets("fiche_def").Select
 
While ligne_fin < 8000
'Traitement copy cellule exporte Rbase
ligne_debut = ligne_debut
ligne_fin = ligne_debut + 23
 
Sheets("fiche_def").Select
cell = "A" & CStr(ligne_debut) & ":" & "F" & CStr(ligne_fin)
 
If Sheets("fiche_def").Cells(ligne_debut, 1) = "" Then
GoTo fin:
End If
 
Range(cell).Select
Application.CutCopyMode = False
Selection.Copy
 
'Traitement colle cellule model fiche défaut
 
Sheets("model").Select
Range("A1:F1").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
 
'Enregistrement fichier
model.Select
model.Copy
 
NomFichier = Chemin & "\" & model.Cells(1, 1) & ".xls"
 
NomFiche = model.Cells(1, 1).Value  'Ajout Nomde la faiche dans l'onglet
Sheets("model").Name = NomFiche     'Ajout Nomde la faiche dans l'onglet
 
ActiveWorkbook.SaveAs Filename:=NomFichier, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
ActiveWorkbook.Close
ligne_debut = ligne_debut + 25
Wend
 
fin:
 
'Boite de dialogue
Dim result As Integer
result = MsgBox("Voici le chemin de vos fichiers créé" & Chemin, vbOKOnly, "Informations")
 
If result = 1 Then
    Shell "C:\windows\explorer.exe " & Chemin, vbMaximizedFocus
End If
 
ActiveWorkbook.Close saveChanges:=False
ActiveWorkbook.Close saveChanges:=False
 
End Sub
Et donc je souhaiterais le convertir en objet dans VB6..
Comment doit je procéder?
Merci d'avance