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 30 31
| Sub CreationCode()
On Error GoTo Message
Dim X As Integer, c1 As String, c2 As String
c1 = Chr(9): c2 = c1 & c1
' Debug.Print Sheets(1).Name 'Listnig
' Debug.Print Sheets(2).Name '01 La mauvaise réputation
' Debug.Print Sheets("01 La mauvaise réputation").Index '2
With ActiveWorkbook.VBProject.VBComponents("Feuil13").CodeModule
X = .CountOfLines
.InsertLines X + 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
.InsertLines X + 2, c1 & "vcellule = Range(""A1"")"
.InsertLines X + 3, c1 & "If vcellule <> """" Then"
.InsertLines X + 4, c2 & "Range(""B"" & Range(""B1"") & "":Q"" & Range(""B1"")).Interior.ColorIndex = 0"
.InsertLines X + 5, c1 & "End If"
.InsertLines X + 6, ""
.InsertLines X + 7, c1 & "If (Target.Rows.Count > 1 Or Target.Columns.Count > 1) Then Exit Sub"
.InsertLines X + 8, ""
.InsertLines X + 9, c1 & "Range(""A1"") = Target.Rows.Address"
.InsertLines X + 10, c1 & "Range(""B1"") = Target.Rows.Row"
.InsertLines X + 11, c1 & "Range(""B"" & Target.Rows.Row & "":Q"" & Target.Rows.Row).Interior.ColorIndex = 6"
.InsertLines X + 12, "End Sub"
End With
Exit Sub
Message:
MsgBox Err.Number, Err.Description
End Sub |
Partager