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
| Sub CréerBouton()
Dim Obj As Object
Dim Code As String
Sheets("Feuil1").Select
'crée le bouton
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=200, Top:=100, Width:=100, Height:=35)
Obj.Name = "BoutonTest"
'texte du bouton
ActiveSheet.OLEObjects(1).Object.Caption = "Tester le bouton"
'Le texte de la macro
Code = "Sub BoutonTest_Click()" & vbCrLf
Code = Code & "Call Tester" & vbCrLf
Code = Code & "End Sub"
'Ajoute la macro en fin de module feuille
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End Sub
Private Sub CommandButton1_Click()
Dim Fich As String, Ligne As Long, Sh As Worksheet
Set Sh = ThisWorkbook.Sheets("Feuil1")
Do
Fich = Application.GetOpenFilename("Excel Files (*classeur2.xls*), *classeur2.xls*")
If Fich = "Faux" Then Exit Sub
Workbooks.Open Fich
With Sheets("Feuil1")
Ligne = Sh.Cells(Sh.Rows.Count).End(xlUp).Row + 2
Sh.Cells(Ligne, 1) = .[A3]
Sh.Cells(Ligne, 2) = .[B3]
Sh.Cells(Ligne, 3) = .[C3]
Sh.Cells(Ligne, 4) = .[D3]
End With
ActiveWorkbook.Close False
Loop
End Sub |
Partager