1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
|
Public Function FN_Crcbx(ByVal z As Integer, ByVal WKB As Workbook)
Dim X As Integer
WKB.Activate
Set Obj = Feuil1.OLEObjects.Add("Forms.ToggleButton.1")
Obj.Height = Feuil1.Range("A" & z).Height
Obj.Width = Obj.Height
Obj.Left = Feuil1.Range("B" & z).Left - Obj.Width
Obj.Top = Feuil1.Range("A" & z).Top
Obj.Object.BackColor = RGB(0, 255, 0)
Obj.Object.Caption = ""
Obj.Name = "Check_" & z
Set Obj = Nothing
With WKB.VBProject.VBComponents("Feuil1").CodeModule
X = .CountOfLines
.InsertLines X + 1, "Sub Check_" & z & "_Click()"
.InsertLines X + 2, vbTab & "Dim WB As Workbook"
.InsertLines X + 3, vbTab & "Set WB = ThisWorkbook"
.InsertLines X + 4, vbTab & "If Check_" & z & ".Value = True Then"
.InsertLines X + 5, vbTab & vbTab & "Check_" & z & ".BackColor = RGB(255, 0, 0)"
.InsertLines X + 6, vbTab & "Else"
.InsertLines X + 7, vbTab & vbTab & "Check_" & z & ".BackColor = RGB(0, 255, 0)"
.InsertLines X + 8, vbTab & "End If"
.InsertLines X + 9, vbTab & "Feuil1.Select"
.InsertLines X + 10, vbTab & "Set WB = Nothing"
.InsertLines X + 11, "End Sub"
.InsertLines X + 12, ""
End With
End Function |
Partager