Untitled
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