[Résolu][VBA] Test de l'existence d'un graphique

Verba_Tim

XLDnaute Occasionnel
Bonjour tout le monde ^^
j'ai un petit problème et je m'en remet à vous une nouvelle fois ^^

Je souhaite tester l'existence d'un graphique dans une page donnée avant d'executer une série d'instruction, mais je n'ai pas trouver comment faire :confused:

Certe je peut voir s'il existe manuellement -_- mais le but est de tester son existence avant de faire un copier coller. S'il existe je copie/colle, sinon je passe au suivant.

Merci d'avance ;)

VB_Tim
 
Dernière édition:
G

Guest

Guest
Re : [VBA] Test de l'existence d'un graphique

Bonjour,

Avec la fonction suivante:

VB:
Function ChartExists(strNomGraphique As String, Optional sh As Worksheet) As Boolean
If sh Is Nothing Then Set sh = ActiveSheet
   On Error Resume Next
   ChartExists = sh.ChartObjects(strNomGraphique).Name <> ""
End Function

Utilisation

If ChartExists("Graphique 1") Then

End if

Ou si le graphe est à cherche ailleurs que sur la feuille active:

If ChartExists("Graphique 1", sheets("Feuil3")) Then

End if

A+
 

job75

XLDnaute Barbatruc
Re : [VBA] Test de l'existence d'un graphique

Bonjour Verba_Tim, salut Hasco :)

Code:
Sub test()
Dim ca As Object
On Error Resume Next
Set ca = ActiveSheet.ChartObjects(1)
If Err Then MsgBox "rien": Exit Sub
MsgBox ca.Name
End Sub
Les MsgBox uniquement pour voir ce qui se passe.

Edit : malheur, j'avais oublié On Error Resume Next !

A+
 
Dernière édition:

Verba_Tim

XLDnaute Occasionnel
Re : [VBA] Test de l'existence d'un graphique

Lu Hasco et Job ^^

Merci a vous ^^
Du coup je trouvé une façon similaire à la version Job ><
Code:
On Error Resume Next
ActiveSheet.ChartObjects("Graphique 1").Select
If Not Err <> 0 = True Then
    ActiveSheet.ChartObjects("Graphique 1").Copy
    WordDoc.Range.PasteAndFormat (13)
Else
    GoTo instruction_suivante
End If

^^ En tout cas merci de votre rapidité/efficacité :)

Sur ce, Bonne journée ;)

Edit: En fait c'est pas encore la même façon de faire :rolleyes:
 

Verba_Tim

XLDnaute Occasionnel
Re : [Résolu][VBA] Test de l'existence d'un graphique

xD c'est pas faux ^^ J'ai pas encore pris mon café depuis ce matin... Donc c'est normal ^^'

Code:
On Error Resume Next
ActiveSheet.ChartObjects("Graphique 1").Select
If Err =  0  Then
    ActiveSheet.ChartObjects("Graphique 1").Copy
    WordDoc.Range.PasteAndFormat (13)
Else
    GoTo instruction_suivante
End If

Merci ;)

A +
 
Dernière édition:

Verba_Tim

XLDnaute Occasionnel
Re : [Résolu][VBA] Test de l'existence d'un graphique

Alerte >< mon problème n'est en fait que partiellement résolu... :s

Le problème c'est que je teste l'existence d'une dizaine de graphs à la suite... Le premier graph inexistant est bien détecter comme tels, et on passe bien au suivant, mais les autres graphs tester eux sont détecter comme... inexistant... Je pense qu'il doit s'agir de la fonction Err qui doit être réinitialisé... Mais comment? ^^" quelqu'un a déjà vécu ce drame??

Merci d'avance ^^'

VB_T
 

Verba_Tim

XLDnaute Occasionnel
Re : [VBA] Test de l'existence d'un graphique

VB:
Function ChartExists(strNomGraphique As String, Optional sh As Worksheet) As Boolean
If sh Is Nothing Then Set sh = ActiveSheet
   On Error Resume Next
   ChartExists = sh.ChartObjects(strNomGraphique).Name <> ""
End Function

Utilisation

If ChartExists("Graphique 1") Then

End if


En fait problème résolu... Ma fonction marche pour UN UNIQUE test, mais la valeur de ERR reste identique par la suite, problème qui n'apparait pas avec la fonction de Hasco.

Merci Maître ;)

A +

VB_T
 

tototiti2008

XLDnaute Barbatruc
Re : [Résolu][VBA] Test de l'existence d'un graphique

Bonjour Verba_tim, Bonjour Hasco, Bonjour job, :)

à tester

Code:
On Error Resume Next
ActiveSheet.ChartObjects("Graphique 1").Select
If Err =  0  Then
    ActiveSheet.ChartObjects("Graphique 1").Copy
    WordDoc.Range.PasteAndFormat (13)
Else
    Err.Clear
    GoTo instruction_suivante
End If
 

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 928
Membres
101 842
dernier inscrit
seb0390