Créer une macro mais dans un autre chiffrier

siocnarf

XLDnaute Occasionnel
Bonjour,

Je souhaiterais que mon programme créé un autre chiffrier (workbooks) et y insère un bouton ainsi qu'une macro. Ce que je vois est que la macro sera créé dans le fichier actuel. Est-ce possible?

Code:
Dim CaseBouton As String
Dim ModificateurHauteurDeLigne As Integer
Dim ModificateurLargeurDeColonne As Integer
Dim ColonneBouton As String
Dim Obj As OLEObject
Dim laMacro As String
Dim x As Integer

ModificateurHauteurDeLigne = 1.5
ModificateurLargeurDeColonneBouton = 31
ColonneBouton = "D"
W = 140
H = 0
L = 0
T = 0

V_StrChiffrierDeBaseFeuille1 = "Serveurs"

CaseBouton = Cells(1, 4).Select

H = ActiveCell.Height * ModificateurHauteurDeLigne
L = ActiveCell.Left
T = ActiveCell.Top
    
      
    'Ajout CommandButton dans la feuille
    Set Obj = ActiveWorkbook.ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
    With Obj
       .Left = L 'position horizontale
       .Top = T 'position verticale
       .Width = W 'largeur
       .Height = H 'hauteur
       .Object.BackColor = RGB(235, 235, 200) 'Couleur de fond
       .Object.Caption = "qpw502.prodna.mrqech"
    End With
    
    'Paramètres pour la création de la macro:
    laMacro = "Sub CommandButton1_Click()" & vbCrLf
    laMacro = laMacro & "X" & vbCrLf
    laMacro = laMacro & "End Sub"
    
    'Si la première feuille s'appelle feuil1 alors on lui donne un bon nom
    'Si la feuille s'appelle autrement que Feuil1 alors on a une erreur 9...
    If FeuilleExiste("Serveurs") Then
        Sheets("Serveurs").Select
        Sheets("Serveurs").Name = "Feuil1"
    End If

    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        x = .CountOfLines + 1
        .InsertLines "Call tester", laMacro
    End With

    If FeuilleExiste("Feuil1") Then
        Sheets("Feuil1").Select
        Sheets("Feuil1").Name = V_StrChiffrierDeBaseFeuille1
    End If
     
    Columns(ColonneBouton & ":" & ColonneBouton).ColumnWidth = 31
    Rows("1:1").RowHeight = H
    
End Sub
Sub Tester()
    MsgBox "Vous avez cliquez sur le bouton test"
End Sub

Merci,
 

Discussions similaires

Réponses
0
Affichages
304
Réponses
9
Affichages
293

Statistiques des forums

Discussions
314 496
Messages
2 110 236
Membres
110 708
dernier inscrit
novy16