Sujet Précédent Sujet Suivant

Probleme sur un code pour création bouton [VB6]

Résolu
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 - 27 avril 2006 à 18:34
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 - 2 mai 2006 à 09:30
bonsoir à tous
avec se code je crée un bouton pour mettre un bouton avec une macro dans une feuille excel avec VB6.
mais j'ai une erreur dans la ligne qui est en rouge,
"erreur 438,l'objet ne gere pas cette propriétée ou cette méthode".
Private Sub Command2_Click()
Dim fichier1 As String
Dim DevisExcel As Object
Dim Obj As Excel.OLEObject
Dim laMacro As String
Dim x As Integer


If fichier.ListIndex = -1 Then
MsgBox "vous n'avez selectionnié aucun fichier", vbCritical, "Erreur"
Else


fichier1 = fichier.Path & "" & fichier.FileName




'ouvrir le fichier excel selectionner


Set DevisExcel = CreateObject("excel.Application")
Workbooks.open FileName:=fichier1, Editable:=True
Set Obj = DevisExcel.Worksheets(1).OLEObjects.Add("Forms.CommandButton.1")
With Obj
.Left = 10
.Top = 5
.Width = 50
.Height = 30
.Object.Caption = "Supprimer"
End With


laMacro = "Sub CommandButton1_Click()" & vbCrLflaMacro laMacro & "Range(""b2:b8500"").FormulaR1C1 ""=DATEVALUE(LEFT(RC[-1],8))"" '=DATEVAL(GAUCHE(A2;8))" & vbCrLflaMacro laMacro & "Range(""b2:b8500"").NumberFormat ""m/d/yyyy""" & vbCrLflaMacro laMacro & "Range(""c2:c8500"").FormulaR1C1 ""=TIMEVALUE(MID(RC[-2],10,8))"" '=TEMPSVAL(STXT(A2;10;8))" & vbCrLflaMacro laMacro & "Range(""c2:c8500"").NumberFormat ""h:mm:ss""" & vbCrLflaMacro laMacro & "Range(""d2:d8500"").FormulaR1C1 ""=MID(RC[-3],19,FIND(""     "",RC[-3],20)-19)""" & vbCrLflaMacro laMacro & "Range(""e2:e8500"").FormulaR1C1 ""=TRIM(MID(RC[-4],LEN(RC[-2])+20,LEN(RC[-4])))"" '=SUPPRESPACE(STXT(A2;NBCAR(D2)+20;NBCAR(A2)))" & vbCrLf
laMacro = laMacro & "Dim Donnees As Range" & vbCrLf
laMacro = laMacro & "Dim NbreLignes&, Lig&, PremErreur&" & vbCrLflaMacro laMacro & "Set Donnees Range([b2], [e2].End(xlDown)) 'Définit le champ ""Données""" & vbCrLflaMacro laMacro & "NbreLignes Donnees.Rows.Count 'Définit le Nbre de Lignes dans Donnéees" & vbCrLflaMacro laMacro & "Application.ScreenUpdating False 'Fige l'affichage (Gain temps)" & vbCrLf
laMacro = laMacro & "With Donnees" & vbCrLf
laMacro = laMacro & ".Copy 'Copie les formules du champ Donnees" & vbCrLf
laMacro = laMacro & ".PasteSpecial Paste:=xlValues 'Fait un collage spéciale Valeurs" & vbCrLflaMacro laMacro & "Application.CutCopyMode False 'quitte le mode couper-coller" & vbCrLf
laMacro = laMacro & ".Sort Key1:=Range(""D2""), Order1:=xlAscending, Key2:=Range(""C2"") _" & vbCrLf
laMacro = laMacro & ", Order2:=xlAscending, Header:=xlNo 'Effectue un tri" & vbCrLf
laMacro = laMacro & "Columns(""A:A"").Delete Shift:=xlToLeft 'Supprime la colonne A" & vbCrLflaMacro laMacro & "For Lig 1 To NbreLignes 'boucle à partir de la ligne 1 de Donnees" & vbCrLf
laMacro = laMacro & "If IsError(.Cells(Lig, 1)) Then 'si en colonne 1 il y a une erreur" & vbCrLf
laMacro = laMacro & "'Détruit toutes les lignes à partir de l'erreur et jusqu'à la dernière ligne de Données" & vbCrLf
laMacro = laMacro & "Rows(Lig & "":"" & .SpecialCells(xlCellTypeLastCell).Rows.Row).Delete Shift:=xlUp" & vbCrLf
laMacro = laMacro & "Exit For 'Sort de la boucle" & vbCrLf
laMacro = laMacro & "End If" & vbCrLf
laMacro = laMacro & "Next Lig" & vbCrLf
laMacro = laMacro & "End With" & vbCrLflaMacro laMacro & "Application.ScreenUpdating True 'Réactive l'affichage" & vbCrLf
 
laMacro = laMacro & "End Sub"
DevisExcel.Visible = True





With DevisExcel.VBProject.VBComponents(ActiveSheet.Name).CodeModule
x = .CountOfLines + 1
.InsertLines x, laMacro
End With
End If
End Sub
auriez vous une idée sue cette erreur
merci
@ plus
petchy

14 réponses

Réponse 1 / 14
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
2 mai 2006 à 08:35
Salut,

Non désolé je ne sais pas pourquoi.

Peu être qu un fichier converti ne peu pas posséder de code (ou alors il manque une opération que tu n'a pas faite..)

Désolé je ne suis pas encore assez doué pour répondre.

Si ce n'est pas déjà fait repose une question dans le forum (en parlant de ton nouveau problème).

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
3
Réponse 2 / 14
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
28 avril 2006 à 09:40
Salut,

Premiere chose, il faut apporter une petite correction.

fichier1 = fichier.Path & "" & fichier.FileName 
Deviendrait
fichier1 = fichier.Path & fichier.FileName

Sinon tu as un nom de fichier de ce type: C:\\1.xls

Ensuite: .VBProject.VBComponents(ActiveSheet.Name).CodeModule  => Ceci appartient à un objet WORKBOOK et Non EXCEL.APPLICATION.

Donc essaie ce code tel quel mais en ajoutant la reference suivante a ton projet: Microsoft Excel 9.0 Object Library. (ou equivalent)

J ai teste et chez moi ceci insere bien le code dans le classeur (en revanche il y a des erreurs de syntaxe dans le code inséré mais ca c'est l'étape suivante)

Donc voici:

Dim fichier1 As String 
Dim AppExcel As Excel.Application 
Dim DevisExcel As Workbook 

Dim Obj As Excel.OLEObject 
Dim laMacro As String 
Dim x As Integer 
Dim wb As Workbook 
If Fichier.ListIndex = -1 Then 
MsgBox "vous n'avez selectionnié aucun fichier", vbCritical, "Erreur" 
Else 

fichier1 = Fichier.Path & Fichier.FileName 

'ouvrir le fichier excel selectionner

Set AppExcel = New Excel.Application 
Set DevisExcel = AppExcel.Workbooks.Open(fichier1, Editable:=True) 

Set Obj = DevisExcel.Worksheets(1).OLEObjects.Add("Forms.CommandButton.1") 
With Obj 
.Left = 10 
.Top = 5 
.Width = 50 
.Height = 30 
.Object.Caption = "Supprimer" 
End With 

laMacro = "Sub CommandButton1_Click()" & vbCrLf 
laMacro = laMacro & "Range(""b2:b8500"").FormulaR1C1 = ""=DATEVALUE( LEFT (RC[-1],8))""  ' =DATEVAL(GAUCHE(A2;8))" & vbCrLf
laMacro =  laMacro & "Range(""b2:b8500"").NumberFormat = ""m/d/yyyy""" & vbCrLf 
laMacro = laMacro & "Range(""c2:c8500"").FormulaR1C1 = ""=TIMEVALUE( MID (RC[-2],10,8))""  ' =TEMPSVAL(STXT(A2;10;8))" & vbCrLf
laMacro =  laMacro & "Range(""c2:c8500"").NumberFormat = ""h:mm:ss""" & vbCrLf 
laMacro = laMacro & "Range(""d2:d8500"").FormulaR1C1 = ""=MID(RC[-3],19,FIND(""     "",RC[-3],20)-19)""" & vbCrLf 
laMacro = laMacro & "Range(""e2:e8500"").FormulaR1C1 = ""=TRIM( MID (RC[-4],LEN(RC[-2])+20,LEN(RC[-4])))""  ' =SUPPRESPACE(STXT(A2;NBCAR(D2)+20;NBCAR(A2)))" & vbCrLf
laMacro = laMacro & "Dim Donnees As Range" & vbCrLf 
laMacro = laMacro & "Dim NbreLignes&, Lig&, PremErreur&" & vbCrLf 
laMacro = laMacro & "Set Donnees = Range([b2], [e2].End(xlDown))  'Définit le champ ""Données""" & vbCrLf
laMacro = laMacro & "NbreLignes = Donnees.Rows.Count  'Définit le Nbre de Lignes dans Donnéees" & vbCrLf
laMacro = laMacro & "Application.ScreenUpdating = False  'Fige l'affichage (Gain temps)" & vbCrLf
laMacro = laMacro & "With Donnees" & vbCrLf 
laMacro = laMacro & ".Copy  'Copie les formules du champ Donnees" & vbCrLf
laMacro = laMacro & ".PasteSpecial Paste:=xlValues  'Fait un collage spéciale Valeurs" & vbCrLf
laMacro = laMacro & "Application.CutCopyMode = False  'quitte le mode couper-coller" & vbCrLf
laMacro = laMacro & ".Sort Key1:=Range(""D2""), Order1:=xlAscending, Key2:=Range(""C2"") _" & vbCrLf 
laMacro = laMacro & ", Order2:=xlAscending, Header:=xlNo  'Effectue un tri" & vbCrLf
laMacro = laMacro & "Columns(""A:A"").Delete Shift:=xlToLeft  'Supprime la colonne A" & vbCrLf
laMacro = laMacro & "For Lig = 1 To NbreLignes  'boucle à partir de la ligne 1 de Donnees" & vbCrLf
laMacro = laMacro & "If IsError(.Cells(Lig, 1)) Then  'si en colonne 1 il y a une erreur" & vbCrLf
laMacro = laMacro & "'Détruit toutes les lignes à partir de l'erreur et jusqu'à la dernière ligne de Données" & vbCrLf 
laMacro = laMacro & "Rows(Lig & "":"" & .SpecialCells(xlCellTypeLastCell).Rows.Row).Delete Shift:=xlUp" & vbCrLf 
laMacro = laMacro & "Exit For  'Sort de la boucle" & vbCrLf
laMacro = laMacro & "End If" & vbCrLf 
laMacro = laMacro & "Next Lig" & vbCrLf 
laMacro = laMacro & "End With" & vbCrLf 
laMacro = laMacro & "Application.ScreenUpdating = True  'Réactive l'affichage" & vbCrLf

laMacro = laMacro & "End Sub" 
AppExcel.Visible = True 

With DevisExcel.VBProject.VBComponents(ActiveSheet.Name).CodeModule 
x = .CountOfLines + 1 
.InsertLines x, laMacro 
End With 
End If 
End Sub 
 

<small> Coloration syntaxique automatique [AFCK]</small>
       

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
0
Réponse 3 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 10:16
salut Julien
merci pour ta réponse,mais il y à encore un probleme,il me met  "erreur 1004",
pourtant je sélectionne bien un fichier Excel,et il dit fichier introuvable
et quand je débogue il me surligne cette ligne :
Set DevisExcel = AppExcel.Workbooks.open(fichier1, Editable:=True)
pourrais tu me dire se qui ne va pas
merci
petchy
0
Réponse 4 / 14
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
28 avril 2006 à 10:24
Salut,

As tu bien modifier la ligne   fichier1 = fichier.Path & "" & fichier.FileName

Si oui,

Essaie de voir la valeur de fichier1 a l'instant ou ca plante: Soit en debig soit par Msgbox Fichier1 juste avant Set DevisExcel = AppExcel.Workbooks.open(fichier1, Editable:=True)

Tu peux aussi essayer de faire juste  Set DevisExcel = AppExcel.Workbooks.open(fichier1)

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 10:28
Re
j'ai essayé ça
MsgBox fichier1
Set DevisExcel = AppExcel.Workbooks.open(fichier1)
mais dans msg il n'y a rien d'inscrit
petchy
0
Réponse 6 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 11:03
salut
pour l'ouverture du fichier c'es bon,en fait il y avait une faute dans fichier1,
donc sa c'est bon,par contre j'ai toujours une erreur sur se code
With DevisExcel.VBProject.VBComponents(ActiveSheet.Name).CodeModule 
x = .CountOfLines + 1 
.InsertLines x, laMacro 
End With 
End If 

petchy
0
Réponse 7 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 11:10
 peut tu aller voir se code car il fonctionne
http://www.vbfrance.com/infomsg/INTEGRE-BOUTON-DANS-EXCEL-VB6-2_716098.aspx
mais moi je voudrais choisir un fichier a partir de ma boite de dialogue,puis l'ouvir.
petchy
0
Réponse 8 / 14
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
28 avril 2006 à 11:40
SAlut,

Vu que tu as corrigé quelques trucs,

Remets ton code pour voir. ou ca en est

Car moi j ai bien reussi a le faire

- choisir  le fichier dans un filelistBox (ou autre le probleme ne vient pas d'ici)
- OUvrir excel
- Inserer me bouton.
- Ecrire dans le code.

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
0
Réponse 9 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 11:43
voila le code
je te remerci pour ton aide
Private Sub Command2_Click()
Dim fichier1 As String
Dim AppExcel As Excel.Application
Dim DevisExcel As Workbook


Dim Obj As Excel.OLEObject
Dim laMacro As String
Dim x As Integer
Dim Wb As Workbook
If fichier.ListIndex = -1 Then
MsgBox "vous n'avez selectionnié aucun fichier", vbCritical, "Erreur"
Else


fichier1 = fichier.Path & fichier.FileName


 




'ouvrir le fichier excel selectionner


Set AppExcel = New Excel.Application
Set DevisExcel = AppExcel.Workbooks.open(fichier1, Editable:=True)
'MsgBox fichier1
'Set DevisExcel = AppExcel.Workbooks.open(fichier1)


Set Obj = DevisExcel.Worksheets(1).OLEObjects.Add("Forms.CommandButton.1")
With Obj
.Left = 10
.Top = 5
.Width = 50
.Height = 30
.Object.Caption = "Supprimer"
End With


laMacro = "Sub CommandButton1_Click()" & vbCrLflaMacro laMacro & "Range(""b2:b8500"").FormulaR1C1 ""=DATEVALUE(LEFT(RC[-1],8))""  '=DATEVAL(GAUCHE(A2;8))" & vbCrLflaMacro laMacro & "Range(""b2:b8500"").NumberFormat ""m/d/yyyy""" & vbCrLflaMacro laMacro & "Range(""c2:c8500"").FormulaR1C1 ""=TIMEVALUE(MID(RC[-2],10,8))""  '=TEMPSVAL(STXT(A2;10;8))" & vbCrLflaMacro laMacro & "Range(""c2:c8500"").NumberFormat ""h:mm:ss""" & vbCrLflaMacro laMacro & "Range(""d2:d8500"").FormulaR1C1 ""=MID(RC[-3],19,FIND(""     "",RC[-3],20)-19)""" & vbCrLflaMacro laMacro & "Range(""e2:e8500"").FormulaR1C1 ""=TRIM(MID(RC[-4],LEN(RC[-2])+20,LEN(RC[-4])))""  '=SUPPRESPACE(STXT(A2;NBCAR(D2)+20;NBCAR(A2)))" & vbCrLf
laMacro = laMacro & "Dim Donnees As Range" & vbCrLf
laMacro = laMacro & "Dim NbreLignes&, Lig&, PremErreur&" & vbCrLflaMacro laMacro & "Set Donnees Range([b2], [e2].End(xlDown))  'Définit le champ ""Données""" & vbCrLflaMacro laMacro & "NbreLignes Donnees.Rows.Count  'Définit le Nbre de Lignes dans Donnéees" & vbCrLflaMacro laMacro & "Application.ScreenUpdating False  'Fige l'affichage (Gain temps)" & vbCrLf
laMacro = laMacro & "With Donnees" & vbCrLf
laMacro = laMacro & ".Copy  'Copie les formules du champ Donnees" & vbCrLf
laMacro = laMacro & ".PasteSpecial Paste:=xlValues  'Fait un collage spéciale Valeurs" & vbCrLflaMacro laMacro & "Application.CutCopyMode False  'quitte le mode couper-coller" & vbCrLf
laMacro = laMacro & ".Sort Key1:=Range(""D2""), Order1:=xlAscending, Key2:=Range(""C2"") _" & vbCrLf
laMacro = laMacro & ", Order2:=xlAscending, Header:=xlNo  'Effectue un tri" & vbCrLf
laMacro = laMacro & "Columns(""A:A"").Delete Shift:=xlToLeft  'Supprime la colonne A" & vbCrLflaMacro laMacro & "For Lig 1 To NbreLignes  'boucle à partir de la ligne 1 de Donnees" & vbCrLf
laMacro = laMacro & "If IsError(.Cells(Lig, 1)) Then  'si en colonne 1 il y a une erreur" & vbCrLf
laMacro = laMacro & "'Détruit toutes les lignes à partir de l'erreur et jusqu'à la dernière ligne de Données" & vbCrLf
laMacro = laMacro & "Rows(Lig & "":"" & .SpecialCells(xlCellTypeLastCell).Rows.Row).Delete Shift:=xlUp" & vbCrLf
laMacro = laMacro & "Exit For  'Sort de la boucle" & vbCrLf
laMacro = laMacro & "End If" & vbCrLf
laMacro = laMacro & "Next Lig" & vbCrLf
laMacro = laMacro & "End With" & vbCrLflaMacro laMacro & "Application.ScreenUpdating True  'Réactive l'affichage" & vbCrLf


laMacro = laMacro & "End Sub"
AppExcel.Visible = True




With DevisExcel.VBProject.VBComponents(ActiveSheet.Name).CodeModule
x = .CountOfLines + 1
.InsertLines x, laMacro
End With
End If
End Sub

petchy
0
Réponse 10 / 14
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
28 avril 2006 à 13:50
Re,

Alors là, je t'avouerai que franchement je sèche.. Car chez moi, le code que tu viens de poster fonctionne parfaitement...

As tu bien mis la référence:  Microsoft Excel 9.0 Object Library. (ou equivalent) ?

Excuses de demander ceci, mais c'est que pour l'instant je ne vois que cela.

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
0
Réponse 11 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 18:11
salut
oui, j'ai bien mis référence Microsoft Excel 11.0 Object Library
moi non plus je ne comprens pas
si tu trouve,fais moi signe
merci
petchy
0
Réponse 12 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
28 avril 2006 à 22:31
Re
sinon peut tu m'envoyé un zip de ton fichier,pour que je puisse comparé
[mailto:pascalecas@aol.com pascalecas@aol.com]
merci
petchy
0
Réponse 13 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
29 avril 2006 à 15:18
salut
j'ai compris pourquoi ça ne fonctionne pas,en fait, mon programme sert à convertir
un fichier texte en fichier Excel,et c'est quand je veut ouvrir se fichier
Excel avec le code si dessus qu'il me fait une erreur,sinon en ouvrant un
autre fichier Excel ça fonctionne.je ne comprends pas,pourquoi ça ne fonctionne
quand je converti mon fichier texte.
aurais tu une idée
merci
petchy
0
Réponse 14 / 14
cs_petchy Messages postés 710 Date d'inscription jeudi 20 février 2003 Statut Membre Dernière intervention 19 mai 2015 4
2 mai 2006 à 09:30
salut Julien
OK,merci de ton aide,je vais regardé la convertion du fichier
un grand merci
bonne journée
@ plus
petchy
0

Discussions similaires

Erreur d’exécution 424 : objet requis
luciol8 -
Marion8316 -

7 réponses
erreur d'execution 9
cs_getrare -
getrare -

7 réponses
erreur d'execution '9'
cs_tracto -
tracto -

10 réponses
Erreur d'exécution '9' : l'indice n'appartient pas à la sélection
ptitemeuh -
ptitemeuh -

4 réponses
Erreur d'exécution 9
rednor -
rednor -

5 réponses
Rejoignez-nous