Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Teste sur cellule

V

VIARD

XLDnaute Impliqué
Bonjour à toutes et tous

Dans mes manips il m'arrive de vouloir tout connaître de l'état d'une cellule
Donc voilà une petite procédure qui rend bien service.
A vous de voir.

Code: 
Sub Test_Cellule()
Dim Ind, Fond, CoulText
Dim StyPolice, Taille, Valeur
Dim Form, Formule, Adr, Aligh

Valeur = ActiveCell.Value
Ind = ActiveCell.Interior.ColorIndex
Fond = ActiveCell.Font.Name
CoulText = ActiveCell.Font.ColorIndex
StyPolice = ActiveCell.Font.Bold
Taille = ActiveCell.Font.Size
Aligh = ActiveCell.HorizontalAlignment
Form = ActiveCell.NumberFormat '= "0.0%"
Adr = ActiveCell.Address
Formule = ActiveCell.Formula
If Aligh = -4131 Then Aligh = "Gauche"
If Aligh = -4108 Then Aligh = "Centré"
If Aligh = -4152 Then Aligh = "Droite"
'---------------------
MsgBox "Valeur Cellule active = " & vbTab & ": " & Valeur & vbNewLine _
& vbNewLine & "Couleur Index fond cellule = " & vbTab & ": " & Ind _
& vbNewLine & "Nom du Font (Police) = " & vbTab & ": " & Fond _
& vbNewLine & "Couleur du Texte = " & vbTab & vbTab & ": " & CoulText _
& vbNewLine & "Style police (Bold) = " & vbTab & vbTab & ": " & StyPolice _
& vbNewLine & "Taille Police (size) = " & vbTab & vbTab & ": " & Taille _
& vbNewLine & "Alignement H = " & vbTab & vbTab & ": " & Aligh _
& vbNewLine & "Format cellule = " & vbTab & vbTab & ": " & Form _
& vbNewLine & "Adresse cellule = " & vbTab & vbTab & ": " & Adr _
& vbNewLine & "Formule cellule = " & vbTab & vbTab & ": " & Formule

End Sub
[\code]

A+
Jean-Paul
 
Trier par date Trier par votes
V

VIARD

XLDnaute Impliqué
Re : Teste sur cellule

Bonjour Dranred et à tous

Tu as tout à fait raison, j'ai mis juste ce qui m'étais utile.
On peut allonger la liste.
Et merci pour ta précision.

Salutation
Jean-Paul
 
Vote positif 0 Vote négatif
V

VIARD

XLDnaute Impliqué
Re : Teste sur cellule

Bonjour à tous

voici la sub légèrement améliorée.
C'est juste une aide à la mise au point d'un projet
ensuite on le supprime.
Pour aidé j'utilise le click droit

PHP: 
Sub Test_Cellule()
Dim Ind, Fond, CoulText
Dim StyPolice, Taille, Valeur
Dim Form, Formule, Adr, Aligh
Dim AdrR1C1, AdrLg, AdrCol, Etat

Valeur = ActiveCell.Value
Ind = ActiveCell.Interior.ColorIndex
Fond = ActiveCell.Font.Name
CoulText = ActiveCell.Font.ColorIndex
StyPolice = ActiveCell.Font.Bold
Taille = ActiveCell.Font.Size
Aligh = ActiveCell.HorizontalAlignment
Form = ActiveCell.NumberFormat
Adr = ActiveCell.Address
Formule = ActiveCell.Formula
If Aligh = -4131 Then Aligh = "Gauche"
If Aligh = -4108 Then Aligh = "Centré"
If Aligh = -4152 Then Aligh = "Droite"
AdrLg = ActiveCell.Row
AdrCol = ActiveCell.Column
AdrR1C1 = "Cells(" & AdrLg & "," & AdrCol & ")"
'---------------------
MsgBox "Valeur Cellule active = " & vbTab & ": " & Valeur & vbNewLine _
& vbNewLine & "TypeName =" & vbTab & vbTab & ": " & TypeName(Valeur) _
& vbNewLine & "Couleur Index fond cellule = " & vbTab & ": " & Ind _
& vbNewLine & "Nom du Font (Police) = " & vbTab & ": " & Fond _
& vbNewLine & "Couleur du Texte = " & vbTab & vbTab & ": " & CoulText _
& vbNewLine & "Style police (Bold) = " & vbTab & vbTab & ": " & StyPolice _
& vbNewLine & "Taille Police (size) = " & vbTab & vbTab & ": " & Taille _
& vbNewLine & "Alignement H = " & vbTab & vbTab & ": " & Aligh _
& vbNewLine & "Format cellule = " & vbTab & vbTab & ": " & Form _
& vbNewLine & "Adresse cellule = " & vbTab & vbTab & ": " & Adr _
& vbNewLine & "Adresse cellule (R1C1) = " & vbTab & ": " & AdrR1C1 _
& vbNewLine & "Formule cellule = " & vbTab & vbTab & ": " & Formule

End Sub

et pour la feuille.

PHP: 
'==================================================================
'----------- Validation sur Right Click de Userform ---------------
'==================================================================
Private Sub WorkSheet_beforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Feuille As Variant, Toto As String
Dim Col%, Lg%, Som$, ColMax%, LgMax%, LgMin%, ColMin%

Feuille = ActiveSheet.Name
Sheets(Feuille).Activate
'------------------------------------
Call Test_Cellule
End Sub
'==============================

A+
Jean-Paul
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
Re : Teste sur cellule

Bonjour.
C'est juste une aide à la mise au point d'un projet
Cliquez pour agrandir...
Alors vous devriez enlevez quasiment tout ce que vous avez prévu de mettre, et qui ne sert à rien parce qu'on le voit déjà, et seulement laisser la seule chose importante qu'on ne voit pas, et qui est souvent source d'erreurs quand c'est autre chose que ce qu'il faudrait, et que ne montre pas du tout son apparences: TypeName(Valeur)
Pensez aux dates et nombres enregistrés sous forme de textes.

Edit: Je n'avais pas vu que vous l'aviez quand même mis, en fin de compte. Mais ce serait plus judicieux de faire en sorte qu'on le voit en même temps que la valeur.
VB: 
MsgBox "Valeur Cellule active = " & vbTab & ": " & Valeur & " (" & TypeName(Valeur) & ")" & vbNewLine _
En fait c'est plus compliqué. J'ai cette fonction dans un truc en cours de développement :
VB: 
Private Function DescrVal(ByVal V) As String
Dim N°Err As Integer
DescrVal = TypeName(V): If DescrVal = "Range" Then V = V.Value: DescrVal = TypeName(V)
Select Case VarType(V)
   Case Is >= vbArray:  DescrVal = Replace(DescrVal, ")", "1 to " & UBound(V, 1) & ", 1 to " & UBound(V, 2) & ")")
   Case vbDouble:       DescrVal = DescrVal & " =" & V
   Case vbCurrency:     DescrVal = DescrVal & " =" & Format(V, "0.0000")
   Case vbDate:         DescrVal = DescrVal & " =" & Format(V, "dd/mm/yyyy hh:mm:ss")
   Case vbString:       DescrVal = DescrVal & " =""" & Replace(V, """", """""") & """"
   Case vbBoolean:      DescrVal = DescrVal & " =" & IIf(V, "True", "False")
   Case vbError: N°Err = CInt(V): Select Case N°Err
      Case xlErrNull:   DescrVal = DescrVal & " =CvErr(xlErrNull)"
      Case xlErrDiv0:   DescrVal = DescrVal & " =CvErr(xlErrDiv0)"
      Case xlErrValue:  DescrVal = DescrVal & " =CvErr(xlErrValue)"
      Case xlErrRef:    DescrVal = DescrVal & " =CvErr(xlErrRef)"
      Case xlErrName:   DescrVal = DescrVal & " =CvErr(xlErrName)"
      Case xlErrNum:    DescrVal = DescrVal & " =CvErr(xlErrNum)"
      Case xlErrNA:     DescrVal = DescrVal & " =CvErr(xlErrNA)"
      Case Else:        DescrVal = DescrVal & " =CvErr(" & N°Err & ")"
      End Select: End Select
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
V

VIARD

XLDnaute Impliqué
Re : Teste sur cellule

Bonjour Double Zéro, Dranred et à tous

J'ai continué quelques manips.
D'une part je trouve pratique de regrouper toutes les infos d'une cellule, même si elles existent déjà en ordre dispersées.
C'est de toute façon une manip temporaire.
Je me suis un peu inspiré du travail de Dranred post #5
Ici je n'ai pas traité les erreurs, c'est effectivement plus tordu.
Donc voici une nouvelle version, si cela peut rendre service.

PHP: 
Sub Test_Cellule()
Dim Ind, Fond, CoulText, StyPolice, Taille, Valeur
Dim Form, Formule, Adr, Aligh, LgPx
Dim AdrR1C1, AdrLg, AdrCol, Etat
Dim LgPt, ForLocal, ForR1C1, ForLocalR1C1

Valeur = ActiveCell.Value: Ind = ActiveCell.Interior.ColorIndex
Fond = ActiveCell.Font.Name: CoulText = ActiveCell.Font.ColorIndex
StyPolice = ActiveCell.Font.Bold: Taille = ActiveCell.Font.Size
Aligh = ActiveCell.HorizontalAlignment
Form = ActiveCell.NumberFormat: Adr = ActiveCell.Address
Formule = ActiveCell.Formula: ForLocal = ActiveCell.FormulaLocal
ForR1C1 = ActiveCell.FormulaR1C1: ForLocalR1C1 = ActiveCell.FormulaR1C1Local
If Aligh = -4131 Then Aligh = "Gauche"
If Aligh = -4108 Then Aligh = "Centré"
If Aligh = -4152 Then Aligh = "Droite"
AdrLg = ActiveCell.Row: AdrCol = ActiveCell.Column
AdrR1C1 = "Cells(" & AdrLg & "," & AdrCol & ")"
LgPx = Round(ActiveCell.Width * 1.333333)
LgPt = ActiveCell.ColumnWidth
Etat = VarType(ActiveCell.Value)
'MsgBox TypeName(Valeur)
If TypeName(Valeur) = "Error" Then Exit Sub 'error non traité
'------------------------------
Select Case Etat
Case 0: Etat = "Cellule vide": Case 1: Etat = "Aucune données valide"
Case 2: Etat = "Nombre entier (intéger)": Case 3: Etat = "Entier Long"
Case 4: Etat = "Nombre virgule flottante simple"
Case 5: Etat = "Nombre virgule flottante double"
Case 6: Etat = "Valeur monétaire"
Case 7: Etat = "Date  = " & Format(ActiveCell, "dd/mm/yyyy hh:mm:ss")
Case 8: Etat = "Valeur chaîne (string)": Case 9: Etat = "Valeur Objet"
Case 10: Etat = "Valeur d'erreur " & N°Err = CInt(ActiveCell)
Case 11: Etat = "Valeur Booléenne"
Case 12: Etat = "Variant (Tableau de variant)": Case 13: Etat = "Objet accès aux données"
Case 14: Etat = "Valeur décimale": Case 17: Etat = "Valeur Octet"
Case 36: Etat = "Variant définition utilisateur": Case 8192: Etat = "Tableau"
End Select
'---------------------
MsgBox "Valeur Cellule active = " & vbTab & ": " & Valeur & " (" & TypeName(Valeur) & ")" & vbNewLine _
& vbNewLine & "TypeName =" & vbTab & vbTab & ": " & TypeName(Valeur) _
& vbNewLine & "Etat Cellule =" & vbTab & vbTab & ": " & Etat _
& vbNewLine & "Couleur Index fond cellule = " & vbTab & ": " & Ind _
& vbNewLine & "Nom du Font (Police) = " & vbTab & ": " & Fond _
& vbNewLine & "Couleur du Texte = " & vbTab & vbTab & ": " & CoulText _
& vbNewLine & "Style police (Bold) = " & vbTab & vbTab & ": " & StyPolice _
& vbNewLine & "Taille Police (size) = " & vbTab & vbTab & ": " & Taille _
& vbNewLine & "Alignement H = " & vbTab & vbTab & ": " & Aligh _
& vbNewLine & "Format cellule = " & vbTab & vbTab & ": " & Form _
& vbNewLine & "Adresse cellule = " & vbTab & vbTab & ": " & Adr _
& vbNewLine & "Adresse cellule (R1C1) = " & vbTab & ": " & AdrR1C1 _
& vbNewLine & "Largeur Cellule en (Pixel) = " & vbTab & ": " & LgPx _
& vbNewLine & "Largeur Cellule en (point) = " & vbTab & ": " & LgPt _
& vbNewLine & "Formula  = " & vbTab & vbTab & ": " & Formule _
& vbNewLine & "FormulaLocal  = " & vbTab & vbTab & ": " & ForLocal _
& vbNewLine & "FormulaR1C1  = " & vbTab & vbTab & ": " & ForR1C1 _
& vbNewLine & "FormulaR1C1Local  = " & vbTab & ": " & ForR1C1, , "Test sur Cellule"
End Sub

Salutation à tous

Jean-Paul
 
Vote positif 0 Vote négatif
V

VIARD

XLDnaute Impliqué
Re : Teste sur cellule

Bonjour à toutes et tous

Depuis j'ai fait quelques manips supplémentaires.
Il y a surement moyen de faire mieux
J'ai tenu compte des alertes "Error" typeErreur.
Le résultat du test est imprimable.
Ceci m'a posé quelques soucis, vue que la MSGBOX n'est pas imprimable dans l'état.
j'ai tenté une image, pas pratique.
Donc je fais une copie sur un formulaire que je supprime après impression.

Voici le fichier d'essai.

A+

Jean-Paul
 

Pièces jointes

  • Test_Sur_Cellule.xls
    55.5 KB · Affichages: 32
Vote positif 0 Vote négatif
V

VIARD

XLDnaute Impliqué
Re : Teste sur cellule

Bonjour BrunoM45, DoubleZero et à tous

Voici une dernière version.
J'ai souvent été confronté aux cellules qui ne respectent pas le format imposé.
exemple le format monétaire dans une cellule elle reste au format Text.
Ce qui rend disgracieux l'alignement dans une colonne.
Le test ici rétabli le format tout en conservant la formule.
De même le test indique le nombre d'espace dans une cellule apparemment vide.

Bien amicalement

Jean-Paul
 

Pièces jointes

  • Test_Cellule.xls
    58.5 KB · Affichages: 29
  • Test_Cellule.xls
    58.5 KB · Affichages: 35
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

S
  • Résolu(e)
Autres VBA pour copier une cellule à gauche de la cellule sélectionnée
Réponses
1
Affichages
2 K
sg394
S
  • Question
Gmail via CDO, attacher un fichier PDF, des adresses, un objet et un corps bien définit, code de Roland_M.
2 3
Réponses
43
Affichages
5 K
Roland_M
M
[REF] Wiki Page 9 de MichelXld
Réponses
0
Affichages
38 K
MichelXld
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…