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
32
33
34
35
36
37
38
39
40
41
| Private Sub changeVal(srcSheet As String, srcRangeName As String, srcIDRangeName As String, IDcol As String)
'Déclaration de l'existence des variables utilisées plus bas
Dim strAddress, strName, str As String
Dim objCell1 As Range
'Routage du traitement des erreurs au cas où...
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
'Arrete l'execution si numéric ; a modifier si l'id n'est pas un numeric
If IsNumeric(ActiveCell.Value) Then Exit Sub
strAddress = ActiveCell.Address(ColumnAbsolute:=False)
If Split(strAddress, "$")(0) <> IDcol Then
Exit Sub
Else
strName = ActiveCell.Value
Set objCell1 = Application.Sheets(srcSheet).Range(srcRangeName).Find(What:=strName, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
str = objCell1.Address
str = Split(str, "$")(2) - 1
ActiveCell.Value = Sheets(srcSheet).Range(srcIDRangeName).Cells.Rows(str).Value
End If
'Gestion des erreurs
ErrorHandler:
Select Case Err.Number
Case 0
Case 28, 2042
Exit Sub
Case Else
Dim strPrompt, strTitle As String
strTitle = "Error handler"
strPrompt = "Une erreur s'est produite avec les caractéristiques suivantes:" & vbCrLf & _
" - numéro: " & Err.Number & vbCrLf & _
" - description: " & Err.Description & vbCrLf & vbCrLf & _
"Veuillez svp noter ces informations et contacter votre administrateur!"
MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
Exit Sub
End Select
End Sub |
[VBA-EXCEL] Colonne de Listes déroulantes
Répondre avec citation
Partager