|
 |
Les Tests
Pas plus de 10 caractères dans la cellule
Sub testNbCaractere()
CellTest = Range("a1").Value
If Len(CellTest) > 10 Then
MsgBox "Pas plus de 10 caractères", vbOKOnly, "Erreur de caractères"
Exit Sub
End If
End Sub
Pas de caractères spéciaux dans la cellule
Sub testCaractereSpeciaux()
CellTest = Range("B1").Value
For x = 1 To Len(CellTest)
Car = Mid(CellTest, x, 1)
If Car = ":" Or Car = "!" Or Car = "-" Or Car = "/" Or Car = " " _
Or Car = "." Or Car = ";" Or Car = "," Or Car = "\" Then
MsgBox "Pas de caractères spéciaux", vbOKOnly, "Erreur de caractères"
Exit Sub
End If
Next
End Sub
Selon la valeur du nombre
Sub SelonCas()
Nombre = ActiveCell.Value
Select Case Nombre
Case 1 To 5
Range("A1").Value = 0
Case 6, 7, 8, 9, 10
Range("A1").Value = 1
Case Else
Range("A1").Value = 1000
End Select
End Sub
Teste la saisie dans une InputBox
Sub testSaisie()
Dim saisie As String
Do While saisie = ""
saisie = InputBox("Entrez une valeur")
Loop
End Sub
Teste si une touche a été tapée pendant l'éxecution d'une macro.
Lors de l'exécution d'une macro Excel ne teste pas l'utilisation du clavier(sauf Echap)
Declare Function GetAsyncKeyState Lib "User32" _
(ByVal vKey As Integer) As Integer
'GetAsyncKeyState est asynchrone - La touche est mémorisée
Sub testToucheA()
For y = 1 To 10000
Application.StatusBar = y
Next
If (GetAsyncKeyState(65) <> 0) Then
MsgBox "Touche A frappée."
End If
End Sub
a ou A = 65
b ou B = 66 ...etc jusqu'à z ou Z = 90
Espace =32
Teste une valeur avec IsNumeric, IsDate et IsEmpty
Utilise la fonction IsNumeric pour tester si une valeur est numérique ou non.
Sub Valeurnum()
Dim MaValeur, MaValeur2, MonTest, MonTest2
MaValeur = "4578"
MonTest = IsNumeric(MaValeur) 'Retourne Vrai
MsgBox MonTest
MaValeur = "4578,456"
MonTest = IsNumeric(MaValeur) 'Retourne Vrai
MsgBox MonTest
MaValeur2 = "daniel"
MonTest2 = IsNumeric(MaValeur2) 'Retourne Faux
MsgBox MonTest2
End Sub
Utilise la fonction IsDate pour tester si une valeur est une date.
Sub ValeurDate()
Dim MaDate, NonDate, TestDate, TestDate2
MaDate = "02 Mai 2002": NonDate = "Daniel"
TestDate = IsDate(MaDate) 'Retourne Vrai
MsgBox TestDate
TestDate2 = IsDate(NonDate) 'Retourne Faux
MsgBox TestDate2
End Sub
Utilise la fonction IsEmpty pour tester si une valeur est vide ou non vide.
Sub TestValeurVide()
Dim MaValeur, MonTest
MaValeur = Empty 'il y a une valeur
MonTest = IsEmpty(MaValeur) ' Test si ma valeur est vide
MsgBox MonTest 'Retourne Vrai
MaValeur = Null 'il n'y a pas de valeur
MonTest = IsEmpty(MaValeur)' Test si ma valeur est vide (EstVide)
MsgBox MonTest 'Retourne Faux
MaValeur = Null 'il n'y a pas de valeur
MonTest = Not IsEmpty(MaValeur) ' Test si ma valeur n'est pas vide (Non EstVide)
MsgBox MonTest 'Retourne Vrai
End Sub
Teste si une macro complémentaire est installée ou non
Ici l'utilitaire d'analyse
Sub testUtilitAnalyse()
If AddIns("Utilitaire d'analyse").Installed = True Then
MsgBox "Utilitaire d'analyse installé"
Else
MsgBox "Utilitaire d'analyse non installé"
End If
End Sub
affiche la liste des compléments
Sub afficheComplement()
For Each a In AddIns
MsgBox a.FullName
Next a
End Sub
Teste si une cellule est vide ou non vide
Teste et sélectionne les cellules vides de la zone A1:A10
Sub testCelluleVide()
[A1:A10].SpecialCells(xlCellTypeBlanks).Select
End Sub
Teste et sélectionne les cellules contenant une formule
Sub testCelluleformule()
[A1:A10].SpecialCells(xlCellTypeFormulas).Select
End Sub
Teste et sélectionne les cellules contenant un nombre
Sub testCellule3()
[A1:A10].SpecialCells(xlCellTypeConstants, 1).Select
' 2 ème argument =1 (nombre)
End Sub
Teste et sélectionne les cellules contenant du texte
Sub testCelluleText()
[A1:A10].SpecialCells(xlCellTypeConstants, 2).Select
' 2 ème argument =2 (texte)
End Sub
Teste et sélectionne les cellules contenant soit du texte soit une valeur
Sub testCellule()
[A1:A10].SpecialCells(xlCellTypeConstants, 3).Select
' 2 ème argument =3 (texte+nombre)
End Sub
Teste et sélectionne les cellules contenant un commentaire
Sub testCelluleText()
[A1:A10].SpecialCells(xlCellTypeComments).Select
End Sub
Teste si l'option "Déplacement après validation est cochée"
Outils>Options>Modifications : "Deplace la sélection après validation"
Sub testDeplacementValidation()
If Application.MoveAfterReturn = True Then
MsgBox "Le déplacement après validation est activé"
Else
MsgBox "Le déplacement après validation est désactivé"
End If
End Sub
Sub testDeplacementValidationDroite()
Application.MoveAfterReturn = True
If Application.MoveAfterReturnDirection = xlToRight Then
MsgBox "Déplacement à droite"
End If
End Sub
xlToLeft= gauche, xlToRight= droit, xlUp= en haut, ou xlDown= en bas
Exemple d'utilisation:
Sub TestValeurCell()
With ActiveCell
Teste si une chaine de caractere a été saisie dans la cellule active
If Application.IsNumber(.Value) = False Then
.Clear
teste si le déplacement après validation est cochée
dans ce cas il faut remonter d'une cellule pour retourner sur la même cellule
If Application.MoveAfterReturn = True Then
ActiveCell.Offset(-1).Select
End If
End If
End With
'Retour au test
ActiveSheet.OnEntry = "TestValeurCell"
End Sub
Teste la version d'excel et de l'OS
Sub TestVersionXL()
versionXL = Val(Application.Version)
Select Case versionXL
Case 8
MsgBox "Excel (97) version " & Application.Version
MsgBox "Excel Version: " & Application.Version & " Build " & Application.Build _
& vbCrLf & vbCrLf & Application.OperatingSystem
Case 9
MsgBox "Excel (2000) version " & Application.Version
MsgBox "Excel Version: " & Application.Version & " Build " & Application.Build _
& vbCrLf & vbCrLf & Application.OperatingSystem
Case 10
MsgBox "Excel (2002) version " & Application.Version
MsgBox "Excel Version: " & Application.Version & " Build " & Application.Build _
& vbCrLf & vbCrLf & Application.OperatingSystem
Case 11
MsgBox "Excel (2003) version " & Application.Version
MsgBox "Excel Version: " & Application.Version & " Build " & Application.Build _
& vbCrLf & vbCrLf & Application.OperatingSystem
Case 12
MsgBox "Excel (2007) version " & Application.Version
MsgBox "Excel Version: " & Application.Version & " Build " & Application.Build _
& vbCrLf & vbCrLf & Application.OperatingSystem
Case Else
MsgBox "Autre version"
End Select
End Sub
[top]
|
