XL 2019 Ajout d'un bouton fixe vba

jui42 · 28 Juillet 2022

Bonjour,
Je cherche un moyen d'ajouter un bouton en dessous d'un tableau sur une feuille auto-générée par VBA.

Aujourd'hui, j'arrive à faire cela à l'aide de la formule donnée par l'enregistreur de macro.
Cependant, les données de mon tableau étant variable, sa taille l'est également. Y-aurait-il une ligne de code permettant d'affecter la position des bouton à une cellule spécifique ?

VB:

    ' ICI JE CREE LE TABLEAU DE TAILLE VARIABLE '
    
    Dim DL As Variant
            
            DL = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row + 3
            ActiveSheet.Cells(DL - 1, "A") = "ENREGISTREMENT"
            ActiveSheet.Range(ActiveSheet.Cells(DL - 1, "A"), ActiveSheet.Cells(DL - 1, "H")).Merge
            ActiveSheet.Cells(DL, "A") = "Nom"
            
            ActiveSheet.Cells(DL + 1, "A") = "Date_reception"
            ActiveSheet.Columns("A").AutoFit
            
            ActiveSheet.Cells(DL + 2, "A") = "N° LOT"
            
            ActiveSheet.Cells(DL, "D") = "VALIDATION DU CONTROLE"
            ActiveSheet.Range(ActiveSheet.Cells(DL, "D"), ActiveSheet.Cells(DL, "E")).Merge
            ActiveSheet.Range(ActiveSheet.Cells(DL + 1, "D"), ActiveSheet.Cells(DL + 2, "E")).Merge
          
            
            
            
            
            ActiveSheet.Range(ActiveSheet.Cells(DL, "B"), ActiveSheet.Cells(DL, "C")).Merge
            ActiveSheet.Range(ActiveSheet.Cells(DL + 1, "B"), ActiveSheet.Cells(DL + 1, "C")).Merge
            ActiveSheet.Range(ActiveSheet.Cells(DL + 2, "B"), ActiveSheet.Cells(DL + 2, "C")).Merge

            ActiveSheet.Cells(DL + 3, "A") = "Visa"
            ActiveSheet.Range(ActiveSheet.Cells(DL + 3, "A"), ActiveSheet.Cells(DL + 4, "A")).Merge
        
            ActiveSheet.Cells(DL + 3, "D") = "Non Conformité"
            ActiveSheet.Range(ActiveSheet.Cells(DL + 3, "D"), ActiveSheet.Cells(DL + 3, "E")).Merge
            
            ActiveSheet.Cells(DL + 2, "F") = "Date"
            ActiveSheet.Range(ActiveSheet.Cells(DL + 2, "F"), ActiveSheet.Cells(DL + 2, "H")).Merge
            
            ActiveSheet.Range(ActiveSheet.Cells(DL + 3, "F"), ActiveSheet.Cells(DL + 4, "H")).Merge
            
            ActiveSheet.Range(ActiveSheet.Cells(DL + 3, "B"), ActiveSheet.Cells(DL + 4, "C")).Merge
            
            ActiveSheet.Range(ActiveSheet.Cells(DL + 4, "D"), ActiveSheet.Cells(DL + 4, "E")).Merge
            ActiveSheet.Range(ActiveSheet.Cells(DL, "F"), ActiveSheet.Cells(DL, "H")).Merge
            ActiveSheet.Range(ActiveSheet.Cells(DL + 1, "F"), ActiveSheet.Cells(DL + 1, "H")).Merge
            ActiveSheet.Cells(DL - 1, "A").Interior.ColorIndex = 15
            ActiveSheet.Cells(DL, "D").Interior.ColorIndex = 15
            ActiveSheet.Cells(DL + 3, "D").Interior.ColorIndex = 15
            ActiveSheet.Range(ActiveSheet.Cells(DL, "A"), ActiveSheet.Cells(DL + 3, "A")).Interior.ColorIndex = 15
          
            
            With ActiveSheet.Cells(DL, "F").Validation
                .Delete
                .Add Type:=xlValidateList, Formula1:="N° Bon de retour, N° de dérogation"
                
            End With
            
            
            With ActiveSheet.Cells(DL + 1, "D").Validation
                .Delete
                .Add Type:=xlValidateList, Formula1:="Accepté, Refusé, Accepté par dérogation"
                
            End With
            
            
            
            With ActiveSheet.Cells(DL + 3, "F").Validation
                .Delete
                .Add Type:=xlValidateList, Formula1:=Format(Date, "dd/mm/yy")
                
            End With
            ActiveSheet.Range(ActiveSheet.Cells(DL - 1, "A"), ActiveSheet.Cells(DL + 4, "H")).Select
            Selection.HorizontalAlignment = xlCenter
            Selection.VerticalAlignment = xlCenter
            Selection.Borders.LineStyle = Excel.XlLineStyle.xlContinuous
            
            ActiveSheet.Range("A2").EntireRow.Delete
            
          ' ICI JE VEUX AJOUTER LE BOUTON VIA MON DL ' 
            
            ActiveSheet.Buttons.Add(610.5, 560.25, 57.75, 12.75).Select
            
            With Selection
                
                .Placement = xlFreeFloating
                .OnAction = "'Z:\Industriel\Projets\Projet contrôle réception\ProjetVBAcode\fiche_op.xlsm'!Feuil1.Imprimer"
                .Characters.Text = "Valider contrôle"
                .Font.Bold = True
           End With

Merci du temps passé à la résolution de mon problème.
Cordialement,

jui42 · 28 Juillet 2022

Re,
Voici le code permettant d'ajouter un bouton sur une position fixe.
Dans mon exemple position variable définit par DL

VB:

            Dim PosG As Integer
            Dim PosH As Integer
            Dim Hauteur As Integer
            Dim Longueur As Integer
            
            
          
            With ActiveSheet.Cells(DL, "I")
                PosG = .Left
                PosH = .Top
                Hauteur = .Height
                Longueur = .Width
            End With
            With ActiveSheet.Buttons
                .Add(PosG, PosH, Longueur, Hauteur).Select
                .OnAction = "'Z:\Industriel\Projets\Projet contrôle réception\ProjetVBAcode\fiche_op.xlsm'!Feuil1.Imprimer"
                .Caption = "Valider contrôle"
            End With

XL 2019 Ajout d'un bouton fixe vba

jui42

XLDnaute Junior

jui42

XLDnaute Junior

Discussions similaires