cs_petchy
Messages postés710Date d'inscriptionjeudi 20 février 2003StatutMembreDernière intervention19 mai 2015
-
21 avril 2006 à 10:58
cs_petchy
Messages postés710Date d'inscriptionjeudi 20 février 2003StatutMembreDernière intervention19 mai 2015
-
21 avril 2006 à 12:10
bonjour
MichelXLD m'a donner un code pour mettre un bouton à l'ouverture d'une feuille Excel que je crée par l'intermediaire de VB6,voici le code :
Private Sub Command2_Click()
Dim ExcelApp As Excel.Application
Dim Wb As Excel.Workbook
Dim Obj As Excel.OLEObject
Dim laMacro As String
Dim x As Integer
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set Wb = ExcelApp.Workbooks.Add(1)
Set Obj = Wb.Worksheets(1).OLEObjects.Add("Forms.CommandButton.1")
With Obj
.Left = 10
.Top = 5
.Width = 80
.Height = 30
.Object.Caption = "Supprimer"
End With
Mac = "call FichierCleaner"
laMacro = "Sub CommandButton1_Click()" & vbCrLf
laMacro = laMacro & Mac & vbCrLf
laMacro = laMacro & "End Sub"
With Wb.VBProject.VBComponents(ActiveSheet.Name).CodeModule
x = .CountOfLines + 1
.InsertLines x, laMacro
End With
End Sub
mais la ligne qui est en rouge me pose un soucis,en fait je voudrais mettre cette macro si dessous sur l'évenement click du bouton
Sub FichierCleaner()
Dim Donnees As Range
Dim NbreLignes&, Lig&, PremErreur&
Set Donnees = Range([b2], [e2].End(xlDown)) 'Définit le champ "Données"
NbreLignes = Donnees.Rows.Count 'Définit le Nbre de Lignes dans Donnéees
With Donnees
.Copy 'Copie les formules du champ Donnees
.PasteSpecial Paste:=xlValues 'Fait un collage spéciale Valeurs
Application.CutCopyMode = False 'quitte le mode couper-coller
.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlNo 'Effectue un tri
Columns("A:A").Delete Shift:=xlToLeft 'Supprime la colonne A
For Lig = 1 To NbreLignes 'boucle à partir de la ligne 1 de Donnees
If IsError(.Cells(Lig, 1)) Then 'si en colonne 1 il y a une erreur
'Détruit toutes les lignes à partir de l'erreur et jusqu'à la dernière ligne de Données
Rows(Lig & ":" & .SpecialCells(xlCellTypeLastCell).Rows.Row).Delete Shift:=xlUp
Exit For 'Sort de la boucle
End If
Next Lig
End With
Application.ScreenUpdating = True 'Réactive l'affichage
End Sub
Quelqu'un aurait il une idée pour intégré le code si dessus .
merci
@plus
petchy
econs
Messages postés4030Date d'inscriptionmardi 13 mai 2003StatutMembreDernière intervention23 décembre 200824 21 avril 2006 à 11:11
Salut,
Ben disons que çà sera un petit peu long. Il suffit juste de compléter la variable laMacro :
Private Sub Command2_Click()
Dim ExcelApp As Excel.Application
Dim Wb As Excel.Workbook
Dim Obj As Excel.OLEObject
Dim laMacro As String
Dim x As Integer
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set Wb = ExcelApp.Workbooks.Add(1)
Set Obj = Wb.Worksheets(1).OLEObjects.Add("Forms.CommandButton.1")
With Obj
.Left = 10
.Top = 5
.Width = 80
.Height = 30
.Object.Caption = "Supprimer"
End With
Mac = "call FichierCleaner"
laMacro = "Sub CommandButton1_Click()" & vbCrLf
laMacro = laMacro & Mac & vbCrLf
jrivet
Messages postés7392Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 21 avril 2006 à 11:11
Salut,
Si j ai bien compris tu veux remplacer le "Call FichierCleaner" Par le code de FichierCleaner.
Dans ce cas essaie ceci.
Mac = "Dim Donnees As Range" & _
"Dim NbreLignes&, Lig&, PremErreur&" & _
" Set Donnees = Range([b2], [e2].End(xlDown)) 'Définit le champ Données " & _
" NbreLignes = Donnees.Rows.Count 'Définit le Nbre de Lignes dans Donnéees" & _
" Application.ScreenUpdating = False 'Fige l'affichage (Gain temps)" & _
" With Donnees" & _
".Copy 'Copie les formules du champ Donnees" & _
".PasteSpecial Paste:=xlValues 'Fait un collage spéciale Valeurs" & _
"Application.CutCopyMode = False 'quitte le mode couper-coller" & _
".Sort Key1:=Range(""D2""), Order1:=xlAscending, Key2:=Range(""C2"") _" & _
", Order2:=xlAscending, Header:=xlNo 'Effectue un tri" & _
"Columns(""A:A"").Delete Shift:=xlToLeft 'Supprime la colonne A" & _
"For Lig = 1 To NbreLignes 'boucle à partir de la ligne 1 de Donnees" & _
"If IsError(.Cells(Lig, 1)) Then 'si en colonne 1 il y a une erreur" & _
"'Détruit toutes les lignes à partir de l'erreur et jusqu'à la dernière ligne de Données" & _
"Rows(Lig & "":"" & .SpecialCells(xlCellTypeLastCell).Rows.Row).Delete Shift:=xlUp" & _
"Exit For 'Sort de la boucle" & _
"End If" & _
"Next Lig" & _
"End With" & _
"Application.ScreenUpdating = True 'Réactive l'affichage" & _
"End Sub"
laMacro = "Sub CommandButton1_Click()" & vbCrLf
laMacro = laMacro & Mac & vbCrLf
laMacro = laMacro & "End Sub"
@+, Julien Pensez: Moteur de Recherche, Réponse Acceptée
jrivet
Messages postés7392Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 21 avril 2006 à 11:13
RE:
OUPS, je me suis totalement planter en fait j ai oublier les VBCRLF pour les retours a la lignes dans le code..... (ou la la faudrait que j ouvre les yeux un peu...)
> petchy: OUBLIE MON POST (meme si y avait de l'idee) @+, Julien Pensez: Moteur de Recherche, Réponse Acceptée