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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
| Sub MODIFIER_FICHE()
'declaration des variables
Dim Plage As Range
Dim cellule As Range
'selection de la feuille données
Sheets("données").Select
'l'utilisateur doit indiquer un service afin de filter les données pour modifier une fiche
a = InputBox("Service recherché?", "Service")
'Si l'utilisateur clique sur le bouton Annuler,
'la fonction renvoie une chaîne de longueur nulle ("") et un message "annulation"
If a = "" Then
MsgBox ("ANNULATION")
Exit Sub
Else
'Sinon le texte est converti en majuscule
Dim LowerCase, UpperCase
LowerCase = a ' Chaîne à convertir. UpperCase = UCase(LowerCase) ' Renvoie la chaine en majuscule.
'Filtre automatique dans la colonne d avec comme critère de recherche la valeur indiquée
ActiveSheet.Range("$A$8:$L$65536").AutoFilter Field:=4, Criteria1:=UpperCase
On Error Resume Next
'selection de la plage des cellules
Set Plage = Application.InputBox("Selectionnez la première cellule de la ligne que vous souhaitez modifier.", "SELECTION", Type:=8)
'si la personne clique sur annuler, un bouton annulation apparait et la modification est annulée
On Error GoTo 0
If Plage Is Nothing Then
MsgBox ("ANNULATION")
Exit Sub
Else
'sinon
'on selectionne la ligne entière
Plage.Select
Range(Selection, Selection.End(xlToRight)).Select
'on la copie
Selection.Copy
'modification de la plage selectionnée
For Each cellule In Plage
'la cellule en cours de modification est colorée
cellule.Interior.ColorIndex = 20
'une fenetre apparait et demande a l'utilisateur d'indiquer le nouveau critère
'et ce tant pour chaque cellule correspondant à un critère
a = InputBox("Nouveau critère", "Nouveau critère", "-", 9000, 9000)
'si cependant la personne clique sur annuler un message "annulation" apparait, la modification est annulée
'et on colle la copie de la ligne non modifiée, la ligne originale
If a = "" Then
MsgBox ("ANNULATION")
cellule.Select
ActiveSheet.Paste
Exit Sub
'sinon valeur entrée convertie en majuscule
Else
LowerCase = a
UpperCase = UCase(LowerCase)
cellule.Value = UpperCase
End If
Next
End If
End If
End Sub |
Partager