Cellule nommée ?

Vous pouvez utiliser - selection.name.name, si la cellule n'a pas de nom , l'erreur 1004 sera retournée,
vous pouvez alors gérer cette erreur avec l'instruction on error resume next.

La cellule sélectionnée fait-elle partie d'une plage ?

1°) if intersect(activecell, range("A1:C10")) is nothing then msgbox "Cellule Active hors A1:C10"

2°) Private Sub Worksheet_selectionChange(ByVal Target As Excel.range)
for each cell In range("maZone")
if Target.address = cell.address then msgbox ("")
next
end Sub

3°) Une autre fonction, qui renvoie le nom de la plage ou son adresse : news

La cellule appelante ?

function TEST() As String
TEST = application.caller.address
end function

Cellule vide ?

1°) if selection.value<>"" then ....

2°) A l'aide d'une procédure et d'une fonction
function rangeisempty(r As range) As Boolean
if application.counta(r) = 0 then
rangeisempty = true
Else rangeisempty = false
end function

Sub test()
dim Myrange As range
Set Myrange = range("A1:C50")
msgbox rangeisempty(Myrange)
end Sub

La cellule contient-elle une formule ?

function Isformula(Rng As range) As Boolean
Isformula = Rng(1).Hasformula
end function
=> écrire ceci dans une cellule =Isformula(A1)

La sélection est-elle une colonne ou une ligne entière ?

Function FullRowOrColumn() As Boolean
If TypeOf Selection Is Excel.range Then
FullRowOrColumn = (Selection.rows.Count = rows.Count) Or _
(Selection.Columns.Count = Columns.Count)
Else
FullRowOrColumn = False
End If
End Function

Hyperlien

Y a-t-il un hyperlien dans une cellule, passée en paramètre ?
Cette fonction est utilisable dans une formule.

Function CheckHyperLinks(rng As Range) As Boolean
'Stop
Dim strTmp As String
On Error Resume Next
strTmp = rng.Hyperlinks(1).Address
CheckHyperLinks = (Err = 0)
Err.Clear
On Error GoTo 0
End Function

Récupérer l'adresse d'un hyperlien
Cette fonction ne fonctionne qu'avec les hypertextes "internes" et non ceux créés à partir d'une formule lien_hypertexte.

Cette fonction est utilisable dans une formule.

Function GetHyperLinks(rng As Range) As String
Dim strTmp As String
strTmp = rng.Hyperlinks(1).Address
If strTmp = "" Then
strTmp = rng.Hyperlinks(1).SubAddress
Else
strTmp = strTmp & " " & rng.Hyperlinks(1).SubAddress
End If
GetHyperLinks = strTmp
End Function

Existence d'une feuille ?

1°) A l'aide d'une fonction et d'une procédure
Sub test()
dim rep As Boolean
rep = IsExist("pipo")
end Sub

function IsExist(toto As String) As Boolean
dim myname As String
On Error Goto Probleme
myname = sheets(toto).name
IsExist = true
Exit function
Probleme:
IsExist = false
end function

2°)
function SheetExists(WSName As String) As Boolean
On Error Resume Next
SheetExists = Len(Worksheets(WSName).Name) > 0
End function
=> ce qui donne If SheetExists("SomeSheet") Then Msgbox "The Sheet Exists" Else Msgbox "The Sheet does Not Exist"

3°)
function ExistSheet(Name As String) As Boolean
On Error Resume Next
ExistSheet = sheets(Name).Name <> ""
Err.Clear
End function

La feuille est-elle blanche ? Y a t-il une valeur, ne serait-ce que du texte dans la feuille

if application.counta(activesheet.cells) = 0 then msgbox "La feuille est vide"

Existence d'un fichier ou Fichier Ouvert

Fichier déjà existant dans un répertoire

1°)
if Dir("F:\My documents\My Workbook.xls") <> "" then ' the file exists, returns "" (empty string) if the file doesn't exist.
end if

2°)
FileExists = Len(DIR(testfile))

3°)
Function IsFile(s As String) As Boolean
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
IsFile = fs.FileExists(s)
End Function
=> Debug.Print IsFile("C:\Junk") '-> True (A file w/ no extension)

4°)
Dim FSO As New Scripting.FileSystemObject
On Error Resume Next
If FSO.GetFile(filepath:="C:\Temp\Book1.xls") Is Nothing Then Debug.Print "Does Not Exist" Else Debug.Print "Exists"

Fichier ouvert ou non ?

Sub UseMyWorkbook
if Not ThereIsOne(MyWorkbook, Among:=workbooks) then workbooks(MyWorkbook).Open
end Sub

function ThereIsOne(itemname As String, Among As Object) As Boolean
dim Item As Object
for each Item In Among
ThereIsOne = (itemname = Item.name)
if ThereIsOne then Exit for 'exit early if found
next Item
end function

Autre méthode : news

Autre méthode inspirée de l'article Q184982 "WD97: VBA function to Check if File or document Is Open" : news

Autre méthode : une fonction, fournie par Rob Bovey

function ClasseurOuvert(ByVal NomDuClasseur As String) As Boolean
On Error Resume next
ClasseurOuvert = (LCase$(workbooks(NomDuClasseur).name) = LCase$(NomDuClasseur))
end function

dans A1, par ex, =ClasseurOuvert("TEST.XLS") renvoie Vrai si TEST est ouvert.

Vérifier si un seul fichier est ouvert : news

Existence d'un commentaire

1ière méthode

Private Sub Worksheet_selectionChange(ByVal Target As Excel.range)
dim HasComment As Boolean
HasComment = Len(Target.NoteText)
if HasComment = true then
msgbox ("voici le commentaire" & Chr(13) & Target.NoteText)
Else
msgbox ("pas de commentaires")
end if
end Sub

Repérer tout les commentaires d'une zone

Public Sub FindComments()

Dim rngToSearch As Excel.range
Dim rngToFind As Excel.range

On Error GoTo ExitFindComments

'Set the range to check for comments
Set rngToSearch = Selection

For Each rngToFind In rngToSearch
If Not rngToFind.Comment Is Nothing Then MsgBox "Comment found in " & rngToFind.Address
Next rngToFind

ExitFindComments:

End Sub

Autre méthode

Sub lireCommentaire()
For Each c In ActiveSheet.range("A1:A3")
On Error Resume Next
MsgBox c.Address & " = " & c.Comment.Text
bug = Err.Number
If Err.Number = 91 Then MsgBox "Pas de commentaire en " & c.Address
Next c
End Sub

Voir aussi là : xl_cellule.htm#cell_comment 

Existence d'une barre d'outils

function CommandbarExists(Barname As String) As Boolean

dim cb As CommandBar

for each cb In CommandBars
if cb.name = Barname then
CommandbarExists = true
Exit function
end if
next cb
CommandbarExists = false

end function

Sub test()
dim s As String
s = "Menu Bar"
if CommandbarExists(s) then
msgbox """" & s & """ exists!!!"
Else
msgbox """" & s & """ does NOT exist :-("
end if
end Sub

Existence d'une application

Outlook est-il installé : ici

Excel déjà ouvert ?

Private declare function findWindow Lib "user32" Alias "findWindowA" (ByVal lpClassname As String, ByVal lpWindowname As String) As long

Sub test()
msgbox ExcelOpen()
end Sub

function ExcelOpen() As Boolean
dim hWndXL As long
'Get Excel window handle
hWndXL = findWindow("XLMAIN", vbNullString)
if hWndXL then ExcelOpen = true
end function

Cette macro prend exemple l'application Microsoft Word.

Option Explicit

function IsAppliOpen(Appliname As String) As Boolean
IsAppliOpen = true
On Error Goto bleme
AppActivate Appliname
AppActivate application.Caption
Exit function
bleme:
IsAppliOpen = false
end function

Sub test()
if IsAppliOpen("Microsoft Word") then
msgbox "Microsoft Word déjà ouvert"
Else
msgbox "Microsoft Word n'est pas ouvert"
end if
end Sub

Tableau croisé dynamique

Existe-t-il un tableau croisé dynamique (tcd) dans la feuille en cours ?

If activesheet.pivottables.count > 0 Then MsgBox "You've got PivotTables."

Le graphe croisé dynamique est rattaché à un tableau croisé dynamique, qui figure sur feuille de calcul.
Ce type de graphe figure toujours dans une feuille graphique propre.

Comment déterminer si un graphique est de type TCD ?
-> le test suivant n'est pas le bon élément de réponse mais peut aider quand même :
  msgbox activechart.haspivotfields <=> indique vrai si le graphique a des pivots (généralement crée avec par défaut)

La cellule fait-elle partie d'un tableau croisé dynamique ?

Function RangeHasPivotTable(rng As Range) As Boolean
'////////////////////////////////////////////////////////////////
'// This code was Made by Juan Pablo G. //
'// Our thanks to Juan Pablo G MVP @ Mrexcel.com //
'////////////////////////////////////////////////////////////////
Dim PT As PivotTable
On Error Resume Next
Set PT = rng.PivotTable
RangeHasPivotTable = (Err.Number = 0)
Err.Clear
On Error GoTo 0
End Function

Autofilter

Actif ou non

If ActiveSheet.AutoFilter Is Nothing Then MsgBox "Aucun filtre"

Colonne filtrée ou non

1°)
Dim i As Integer
Dim rangeFilter As range
Set rangeFilter = ActiveSheet.AutoFilter.range.CurrentRegion
For i = 1 To ActiveSheet.AutoFilter.Filters.Count
If ActiveSheet.AutoFilter.Filters.Item(i).On Then
MsgBox "La colonne " & rangeFilter.Columns(i).Address & " est dans le filtre"
Else
MsgBox "La colonne " & rangeFilter.Columns(i).Address & " n'est pas dans le filtre"
End If
Next

2°)
Function test(adresse) As Boolean
test = ActiveSheet.AutoFilter.Filters.Item(2).On
End Function

Presse-papier vide ou non

1°)
Sub CheckClipboard()
Dim MyString as String
Set MyData = New DataObject
MyData.GetFromClipboard
MyString = MyData.GetText
If MyString = "" Then
MsgBox ("Clipboard is empty.")
Else
MsgBox MyString
End If
End Sub

2°)
declare function countClipboardformats Lib "User32" () As long
Sub Test()
if countClipboardformats = 0 then msgbox "Presse-papiers vide"
end Sub

Une procédure existe-elle ?

Dim VBC As VBComponent, L As Long
Set VBC = Nothing
On Error Resume Next
Set VBC = ActiveWorkbook.VBProject.VBComponents("MonModule")
On Error GoTo 0
If VBC Is Nothing Then
MsgBox "Ce module n'existe pas."
Else
L = 0
On Error Resume Next
L = VBC.CodeModule.ProcStartLine("MaProcédure", vbext_pk_Proc)
On Error GoTo 0
If L = 0 Then MsgBox "La procédure ""MaProcédure"" n'existe pas."
End If

Procédure déjà en cours d'exécution
En fait, le principe est d'utiliser une fonction au début de l'exécution d'une procédure pour indiquer si une macro tourne, ainsi supposant qu'un autre code s'active, il devra vérifier cette indication en contrôlant la valeur de MakroActive ; voici le message original : news

function MakroActive(Optional ActivateIt As Variant) As Boolean
Static MIsActive As Boolean
On Error Resume Next
If Not IsMissing(ActivateIt) Then MIsActive = CBool(ActivateIt)
MakroActive = MIsActive
end function

Feuille protégée ou non

Voici une fonction VBA qui permet de savoir si une feuille de calcul l'est :

Function IsPasswordProtected(Sheet As Worksheet) As Boolean
On Error Resume Next

IsPasswordProtected = False
If Sheet.ProtectContents = False Then Exit Function '(sheet is not
protected anyway)
Sheet.Unprotect password:=""

If Err > 0 Then IsPasswordProtected = True
End Function

Feuille protégée avec l'option UserInterfaceOnly ?

If ActiveSheet.ProtectionMode Then
    MsgBox "Feuille protégée avec l'option UserInterfaceOnly".
endif

Classeur protégé ou non

Il n'y a pas de méthode pour savoir directement s'il est protégé ou non, il faut tenter de l'ouvrir et vérifier si ce fut avec succès ou non.
Attention, la macro ci-dessous réagira comme si le classeur est protégé si celui-ci n'existe pas. Vous devez donc tenir compte de cela, en incluant peut-être une vérification d'existence du fichier.

Sub OpenFile()
Dim wkbBook As Workbook
Application.DisplayAlerts = False
On Error Resume Next
''' First line only required when doing this in a loop.
Set wkbBook = Nothing
Set wkbBook = Workbooks.Open("C:\MyBook.xls")
On Error GoTo 0
If wkbBook Is Nothing Then
MsgBox "Workbook was password protected."
Else
MsgBox "Workbook opened"
End If
Application.DisplayAlerts = True
End Sub

Projet VBA protégé ou non (par Ole P. Erlandsen)

Function ProtectedVBProject(ByVal wb As Workbook) As Boolean
' returns TRUE if the VB project in the active document is protected
Dim VBC As Integer
VBC = -1
On Error Resume Next
VBC = wb.VBProject.VBComponents.Count
On Error GoTo 0
If VBC = -1 Then
ProtectedVBProject = True
Else
ProtectedVBProject = False
End If
End Function

Exemple: If ProtectedVBProject(ActiveWorkbook) Then Exit Sub

Formulaire

Chargé ou non ?
( ... en mémoire )

function FormIsLoaded(MyFormName As String) as boolean
dim i As integer
FormIsLoaded = False
for i = 0 to forms.count - 1
if forms(i).formName = MyFormName Then
FormIsLoaded = True
exit function ' Quit function once form has been found.
end if
next i
end function

Affiché ou non ?

Contrôler la propriété Visible du formulaire

S'agit-il d'une vrai variable tableau ou plutôt d'un objet, comme un objet range ?
Fonction de Laurent L. en réponse au sujet "Re: Bug report", le mercredi 20 septembre 2000 16:24, sur microsoft.public.excel.programming

Function IsRealArray(Variable) As Boolean
IsRealArray = IsArray(Variable) And Not IsObject(Variable)
End Function

Ceci est un sujet controversé auquel je n'ai pas tout compris, voici le message à l'origine : news

Pour d'autres infos sur les variables tableaux, regardez ici : xl_vba_2.htm#Variables_tableau

Existence d'un caractère

Date: Mon, 31 Jan 2000 18:26:38 From: Laurent L. Subject: Re: Tester si un caractère existe Newsgroups: microsoft.public.fr.excel

Soit dans une cellule le chiffre "1234567" et on souhaite faire différents tests via VBA:

* existence du nombre 3 : If ActiveCell.Text Like "*1*" Then ...
* existence des nombres 3 et 1 : If ActiveCell.Text Like "*1*" And ActiveCell.Text Like "*3*" Then...

En plus puissant (Excel 97) :

Function DansChaîne(Texte As String, Cars As String)
Dim NbC As Integer
NbC = Len(Cars)
DansChaîne = Evaluate("COUNT(SEARCH(""*""&MID(""" & Cars & _
""",ROW(1:" & NbC & "),1) & ""*"",""" & Texte & """))") = NbC
End Function

Par exemple, DansChaîne(ActiveCell.Text,"1357adtyUP0!n&") renvoie True si tous les caractères 1357adtyUP0!n& se trouvent au moins une fois dans le texte de la cellule active.

**************************

Réponse de C. H. à cette question dans la feuille:
=SI(ESTNUM(CHERCHE(3;A1));"trouvé";"non trouvé")
=SI(ET(ESTNUM(CHERCHE(1;A1));ESTNUM(CHERCHE(3;A1)));"trouvé";"non trouvé")

La fonction CHERCHE(val cherchée;cellule) renvoie la position du caractère trouvé et #VALEUR! si il n'existe pas