Discussion :

[dev_php51]

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

[DarkVader]

Bonjour,
1/ Commencer par nettoyer ton code afin d'avoir un code propre
2/ Utiliser des objects nommés
en résumé, programmer proprement, ensuite qu'il s'agisse de VB ou VBA, pas de différence
(sauf à ajouter sous VB une référence à Excel)

[dev_php51]

Merci pour ta réponse:

Voila j'arrive jusque la pour l'instant.. et il me renvoi une erreur sur la derniere ligne

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
Private Sub Ouvrir_Click()
'variable fichier
Dim Chemin As String
Dim FichierRbase As String
Dim FichierModele As String
 
Dim oExcel As Excel.Application
Dim oWk_Rbase As Workbook
Dim oWk_Modele As Workbook
 
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True 'Masque l'application excel (valeur par défaut)
 
'Selection Fichier Rbase
FichierRbase = Application.GetOpenFilename("Excel (*.xls), *.xls", 1, "Sélectionner le Fichier d'Exportation de Rbase pour les Fiches de Défauts")
Set oWk_Rbase = oExcel.Workbooks.Open(FichierRbase)
 
'Selection Fichier Modele
FichierModele = Application.GetOpenFilename("Excel (*.xls), *.xls", 1, "Sélectionner le Fichier Modele")
Set oWk_Modele = oExcel.Workbooks.Open(FichierModele)
 
 
'Mise en forme du fichier Rbase
oWk_Rbase.Sheets(1).Columns("A:D").Select  ->>>> c'est ici qu'il y a un problem
Selection.Delete Shift:=xlToLeft  ->> ici je ne trouve pas d'equivalent

[DarkVader]

Ha les mauvaises manies de l'enregistreur de macro

Code :

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

1
2
'Mise en forme du fichier Rbase
oWk_Rbase.Sheets(1).Columns("A:D").Delete Shift:=xlToLeft

->> ici je ne trouve pas d'equivalent

Normal, ça ne sert à rien

[dev_php51]

Si cela sert a supprimer la colonne de A à D toute entier

Sinon est il possible d'associer un fichier excel à un projet VB6 ..?
qui me sert de model.?

[DarkVader]

Si cela sert a supprimer la colonne de A à D toute entier .../...

Code :

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

1
2
'Mise en forme du fichier Rbase
oWk_Rbase.Sheets(1).Columns("A:D").Delete Shift:=xlToLeft

Normal, ça ne sert à rien

Re : Si le code précédemment cité fait la même chose, c'est bien que le couple «Select/Selection» ne sert à rien.

Sinon est il possible d'associer un fichier excel à un projet VB6 ..?
qui me sert de model.?

En clair ?