Untitled

 avatar
unknown
vbscript
a year ago
3.2 kB
7
Indexable
Sub ajouter_button()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim nextEmptyRow As Long
    Dim totalHTRow As Long
    Dim TVA20Row As Long
    Dim TotalTTCRow As Long
    Dim newRange As Range ' Déclarer une variable pour stocker la plage de la nouvelle ligne
    
    Set ws = ThisWorkbook.Sheets("Facture") ' Nom de votre feuille
    
    If Range("K8") = "" Or Range("K9") = "" Or Range("K10") = "" Or Range("K11") = "" Or Range("K12") = "" Then
        MsgBox ("Des informations manquantes")
    Else
        ' Recherche de la dernière ligne utilisée dans la colonne B
        lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        
        ' Trouver la prochaine ligne vide dans la colonne B
        If lastRow < 10 Then
            nextEmptyRow = 10
        Else
            nextEmptyRow = lastRow + 1
        End If
        
        ' Vérifier si "Total HT", "TVA 20%" et "Total TTC" sont sur la même ligne que la prochaine ligne vide
        totalHTRow = Application.Match("Total HT", ws.Columns("E"), 0)
        TVA20Row = Application.Match("TVA 20%", ws.Columns("E"), 0)
        TotalTTCRow = Application.Match("Total TTC", ws.Columns("E"), 0)
        
        If Not IsError(totalHTRow) And totalHTRow = nextEmptyRow Then
            ' Copier la ligne "Total HT" et la coller juste en dessous
            ws.Rows(totalHTRow).Copy
            ws.Rows(totalHTRow + 1).Insert Shift:=xlDown
            Set newRange = ws.Rows(totalHTRow + 1) ' Définir la plage de la nouvelle ligne
            Application.CutCopyMode = False ' Pour effacer la sélection
        End If
        
        If Not IsError(TVA20Row) And TVA20Row = nextEmptyRow Then
            ' Copier la ligne "TVA 20%" et la coller juste en dessous
            ws.Rows(TVA20Row).Copy
            ws.Rows(TVA20Row + 1).Insert Shift:=xlDown
            Set newRange = ws.Rows(TVA20Row + 1) ' Définir la plage de la nouvelle ligne
            Application.CutCopyMode = False ' Pour effacer la sélection
        End If
        
        If Not IsError(TotalTTCRow) And TotalTTCRow = nextEmptyRow Then
            ' Copier la ligne "Total TTC" et la coller juste en dessous
            ws.Rows(TotalTTCRow).Copy
            ws.Rows(TotalTTCRow + 1).Insert Shift:=xlDown
            Set newRange = ws.Rows(TotalTTCRow + 1) ' Définir la plage de la nouvelle ligne
            Application.CutCopyMode = False ' Pour effacer la sélection
        End If
        
        ' Ajouter les valeurs des cellules K9 à K12 au tableau commençant à la ligne nextEmptyRow
        ws.Cells(nextEmptyRow, "B").Value = Range("K9").Value
        ws.Cells(nextEmptyRow, "C").Value = Range("K10").Value
        ws.Cells(nextEmptyRow, "D").Value = Range("K11").Value
        ws.Cells(nextEmptyRow, "E").Value = Range("K12").Value
        
        ' Ajouter des bordures à la nouvelle ligne
        If Not newRange Is Nothing Then
            With newRange.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        End If
        
        MsgBox ("Valeurs ajoutées avec succès.")
    End If
End Sub
Editor is loading...
Leave a Comment