problème avec function

Version imprimable

:salut:

J'aimerai créer un fonction qui me renvoi un objet de type Worksheet, selon un nom en paramètre. C'est a dire que si la sheets existe il me renvoi l'objet pointant vers celle-ci, sinon il en crée un nouvelle et me renvoi l'objet pointant vers cette nouvelle sheets.

Ce qui donne :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
'Retourne la feuille nommé selon le paramètre sheetsName (soit une new soit celle déjà existante)
Function GiveMeSheets(sheetsName As String) As Worksheet
    Dim oneSheets As Worksheet
 
    'Desactive les messages d'erreurs
    On Error Resume Next
 
    ' On cré un objet sheet selon le nom en paramètre
    Set oneSheets = ActiveWorkbook.Sheets(sheetsName)
 
    'Si il y a erreur, alors la feuille n'existe pas, sinon elle existe
    If Err <> 0 Then
        'Feuille inexistante, donc on la cré
        insertSheet (sheetsName) 'Cette function fonctionne correctement car la création a bien lieu
        Set oneSheets = ActiveWorkbook.Sheets(sheetsName)
    End If
 
    'Reactive les message d'erreurs
    On Error GoTo 0
 
    GiveMeSheets = oneSheets
End Function

Mais lorsque je fais appel a cette fonction j'obtiens l'erreur suivante:

Code:

1
2
3
 
runtime-error '91':
Object variable or With block variable not set

Quelqu'un pourait-il m'expliquer le pourquoi du comment....

Merci

Teste ça... mais je n'écrirais pas ça comme ça...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Function GiveMeSheets(sheetsName As String) As Worksheet
    Dim oneSheets As Worksheet
 
    'Desactive les messages d'erreurs
    On Error Resume Next
 
    ' On cré un objet sheet selon le nom en paramètre
    Set oneSheets = ActiveWorkbook.Sheets(sheetsName)
 
    'Si il y a erreur, alors la feuille n'existe pas, sinon elle existe
    If Err = 0 Then exit sub
    'Reactive les message d'erreurs
    On Error GoTo 0
 
    'Feuille inexistante, donc on la crée
    insertSheet (sheetsName) 'Cette function fonctionne correctement car la création a bien lieu
    Activesheet.name = sheetsName
    Set oneSheets = ActiveWorkbook.Sheets(sheetsName)
    GiveMeSheets = oneSheets
End Function

14/11/2007, 16h04
wind_vinch

hello, merci pour t'a réponse ouskel'n'or, j'ai essayé ta fonction mais elle ne fonctionne pas. Il me dit que je ne suis pas autorisé a quitter une fonction ou un sub.
Si tu pense qu'il faudrait faire cela autrement dit le moi, c'est pas un problème si faut changer la fonction
14/11/2007, 16h10
ouskel'n'or

:oops: Remplace If Err = 0 Then exit sub
par

Code:

If Err = 0 Then exit function
14/11/2007, 16h22
SilkyRoad

bonjour

Remplace

Code:

GiveMeSheets = oneSheets

par

Code:

Set GiveMeSheets = oneSheets

bon après midi
michel
14/11/2007, 16h30
wind_vinch

Wééé, merci SilkyRoad, ca fonctione (avec ma fonction original aussi).

Merci encore.

Hé ouskel'n'or dis moi si t'as un meilleur code pour la fonction giveMeSheets

Code:

1
2
3
4
5
6
7
8
9
10
11
Function GiveMeSheets(sheetsName As String) As Worksheet
    Dim oneSheets As Worksheet
    On Error Resume Next
    Set GiveMeSheets = ActiveWorkbook.Sheets(sheetsName)
    On Error GoTo 0
    If GiveMeSheets Is Nothing Then
        ActiveWorkbook.Sheets.Add
        ActiveSheet.Name = sheetsName
        Set GiveMeSheets = Worksheets(sheetsName)
    End If
End Function