XL 2019 Copier coller/ insertion image sur excel VBA

[decga]

Bonjour,

je suis actuellement en train de crée un formulaire de gestion de dépenses
Dans le fichier excel j'ai un bouton "ajouter une dépense" qui ouvre un userform qui demande le montant, la date, le type, la désignation et le destinataire de la dépense
A chaque fois que le userform est validé cela insère une nouvelle ligne

Mon problème c'est que j'aimerais ajouter automatiquement un icône de poubelle en face de chaque ligne qui permettrais de supprimer la ligne en question
L'image de poubelle de base doit se trouver sur le fichier excel et la macro ne doit pas avoir à aller chercher l'image dans un dossier

Auriez vous la solution ?

merci d'avance

 

[patricktoulon]

bonjour
vire tout code dans ton userform et met ceci

Option Explicit

Private Sub validerButton_Click()
    Dim message$, location As Range
    message = message & IIf(designationBox = "", "1°Remplir la désignation de la dépense" & vbCrLf, "")
    message = message & IIf(Not IsDate(dateBox), " 2°Remplir la date de la dépense" & vbCrLf, "")
    message = message & IIf(montantBox.Value <= 0, "3°Le montant de la dépense doit être rempli et  positif" & vbCrLf, "")
    message = message & IIf(Not IsNumeric(montantBox), "3°Uniquement les valeurs numérique sont acceptées pour le montant" & vbCrLf, "")
    message = message & IIf(typeComboBox.ListIndex = -1, "4°Sélectionner le type de dépense" & vbCrLf, "")
    message = message & IIf(destinataireComboBox.ListIndex = -1, "5°Sélectionner le destinataire de la dépense" & vbCrLf, "")

    'le message te donne le ou les composants non ou non dument (remplis)
    If message <> "" Then affichagLBL.Caption = message: Beep: Exit Sub

    UserForm1.Hide    'fermer le formulaire

    With Feuil1
        .Rows(15).Insert shift:=xlUp    'Insert une nouvelle ligne lorsque la saisie du formulaire est validé
        'inscription des valeurs
        Range("C15:g15") = Array(designationBox.Value, dateBox.Value, montantBox.Value, typeComboBox.Value, destinataireComboBox.Value)
        'Incrémente le numéro de la dépense
        Range("B15") = Range("B16") + 1
        'redimensionnement de la colone H
        'Columns("H:H").ColumnWidth = 3.5'une fois que c'est fait pas la peine d'y retoucher
        Rows(15).RowHeight = 20    'redimensionnement de la ligne 6

        .Shapes("corbeille").Copy: .Paste    'on copy limage original et on colle dans la feuille
        Set location = .[H15]    'elle doit venir sur cette cellule
        'on la place sur cette dite cellule
        With .Shapes(.Shapes.Count - 1)
            'on la nomme distinctement avec le numero incrementé en colonne "B"
            .Name = "p" & [b15].Value
            .Top = location.Top + ((location.Height - .Height) / 2)    'on la centre
            .Left = location.Left
            .OnAction = "supprime_ligne"    'on designe l'action a faire a cette nouvelle shape (la sub est dans un module)
        End With
    End With

    Unload Me    'initialise le formulaire

End Sub

la sub dans le module

Option Explicit
Sub supprime_ligne()
    Dim shap As Shape, rowW As Range
    Set shap = ActiveSheet.Shapes(Application.Caller)
    Set rowW = shap.TopLeftCell.EntireRow
    rowW.Delete
    shap.Delete
End Sub

terminé

 

[kingfadhel]

Bonjour à tous,

@decga j'ai une autre proposition:
la suppression d'une ligne de fais en double cliquant sur la colonne B de la même ligne:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
''/// si tu fais double click sur la cellule Bxx la ligne xx sera supprimer
If Target.Column = 2 And Target.Row > 1 Then
Application.EnableEvents = False
If Not Application.CountBlank(Target.EntireRow) = Me.Columns.Count Then Target.EntireRow.Delete
Application.EnableEvents = True
End If
End Sub