Ajouter uniquement une seule feuille en VBA

**fochive** · 05/12/2019, 01h17

Bonjour a tous ,

je débute le VBA :

Mon code si dessous permet d'ajouter une feuille à l'onglet de mon projet VBA mais seulement , à chaque fois que j’exécute mon projet c'a ajoute une nouvelle feuille .

Merci de bien vouloir m'aider a optimiser mon code pour que la feuille créée ne s'incrémente plus à chaque fois que j'exécute mon projet .

NB: je récupéré les données dans une Bd avec une requete et je stock ces données sur la Feuill1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 ActiveWorkbook.Worksheets.Add
Onglet = "Feull1" & ActiveSheet.Name

**Pierre Fauconnier** · 05/12/2019, 06h33

Salut.

Je ne sais pas trop ce que ton code est censé réaliser (la deuxième ligne, notamment), mais quoi qu'il en soit, c'est une question d'architecture de code. Découpe ton code en procédures qui ont une et une seule fonctionnalité au sein de ton process. Dès lors, tu pourras décider quand tu appelles le code qui ajoute une feuille à ton classeur.

Une façon rapide (mais barbare) de faire serait de créer une nouvelle feuille, de la nommer et de voir si une exception est levée et agir en conséquence: nommer autrement, supprimer la feuille créée, ...

Une façon plus fiable de n'insérer une nouvelle feuille qu'une seule fois est de la nommer d'une manière qui te permette de tester son existence. Dès lors, avant de la créer, tu testes si elle existe. Si elle n'existe pas, tu la crées, sinon tu ne la crées pas... Le problème est qu'il n'y a pas que des feuilles de calcul dans un classeur, et que les noms des onglets (quelles que soient les feuilles) sont uniques dans le classeur. Il s'agit donc de tester qu'une feuille (de calcul ou autre) existe ou pas, et d'agir en fonction du résultat, car si tu testes l'existence d'une feuille uniquement sur les worksheets, ton code pourrait alors créer une feuille dont le nom existe déjà pour un autre onglet, ce qui lèverait également une exception.

Voici une fonction générique qui teste l'existence d'un onglet dans un classeur, une fonction générique qui crée une feuille de calcul et une fonction générique qui récupère une feuille de calcul selon son nom. La procédure de test permet de créer ou de récupérer une feuille de calcul sur base de son nom en étant sûr qu'un onglet du classeur n'existe pas sous ce nom. A toi à articuler les fonctions dans ton code, en gardant à l'esprit que tes procédures et fonctions doivent être courtes et surtout ne réaliser qu'une seule action. Tu maîtrises alors parfaitement ton code et sais déterminer à quel moment et pour quelle raison tu appelles telle procédure ou fonction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Function SheetExists(Name As String) As Boolean
  Dim Counter As Long: Counter = 1
 
  Do While Counter <= Sheets.Count And Not SheetExists
    If StrComp(Name, Sheets(Counter).Name, vbTextCompare) = 0 Then SheetExists = True
    Counter = Counter + 1
  Loop
End Function
 
Function GetNewWorksheet(Name As String) As Worksheet
  If Not SheetExists(Name) Then
    Set GetNewWorksheet = Worksheets.Add()
    GetNewWorksheet.Name = Name
  End If
End Function
 
Function getWorkSheet(Name As String) As Worksheet
  Dim Counter As Long: Counter = 1
 
  Do While Counter <= Worksheets.Count And getWorkSheet Is Nothing
    If StrComp(Name, Worksheets(Counter).Name, vbTextCompare) = 0 Then Set getWorkSheet = Worksheets(Counter)
    Counter = Counter + 1
  Loop
End Function
 
Sub Test()
  Dim Name As String
  Dim sh As Worksheet
 
  Name = "graphique1"
  Set sh = getWorkSheet(Name)
  If sh Is Nothing Then
    Set sh = GetNewWorksheet(Name)
    If Not sh Is Nothing Then
      MsgBox "Lafeuille a été créée"
    Else
      MsgBox "L'onglet existe déjà mais n'est pas une feuille de calcul"
    End If
  Else
    MsgBox "La feuille existait déjà"
  End If
End Sub

Ca a l'air complexe mais c'est à mon avis la seule façon de pouvoir gérer tous les cas possibles sans lever d'erreur.

**fochive** · 05/12/2019, 10h58

Bonjour ,

votre code m'aide beaucoup je l'ai intégrer à mon projet ça marche parfaitement mais les données provenant de la Bd ne sont plus stockés sur la feuille crée.
Voici mon code merci de m'aider a adapter pourque les données de la requêtes soivent stocker dans la feuille crée.

j'aimerai également que quand la feuille existe déjà, ça ouvre la feuille existant que d'envoyer une message box merci infiniment.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub FiltrerMysqlESS()
 
    Application.ScreenUpdating = False
 
    ' Connect to the database
    Dim connected As Boolean
    connected = Connect("xxxxx", "xxxxx", "xxxxxx,xxxxx", "xxxxxx")
 
    If connected Then
Dim SQLForTempTab As String
Dim OPT As String
Dim EmpId As String
Dim Onglet As String
 
Dim Name As String
Dim sh As Worksheet
Name = "Feuil1"
 
OPT = ActiveSheet.Range("E4").Value
 
 
SQLForTempTab = "SELECT  ReportD.Name, ReportD.Activity FROM BD1.dbo.ReportD ReportD WHERE (ReportD.WBS)='" & OPT & "';"
 
'ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
'Onglet = "Feuil1" & ActiveSheet.Name
 
Set sh = getWorkSheet(Name)
If sh Is Nothing Then
Set sh = GetNewWorksheet(Name)
If Not sh Is Nothing Then
MsgBox "Lafeuille a été créée"
Else
MsgBox "L'onglet existe déjà mais n'est pas une feuille de calcul"
End If
Else
MsgBox "La feuille existait déjà"
End If
 
 
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:="ODBC;DSN=MYSQL;", _
Destination:=Range("$A$1")).QueryTable
.CommandText = SQLForTempTab
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = Onglet
.Refresh BackgroundQuery:=False
 
 
End With
 
End If
 
End Sub

**Pierre Fauconnier** · 05/12/2019, 11h42

Envoyé par fochive

Bonjour ,

votre code m'aide beaucoup je l'ai intégrer à mon projet ça marche parfaitement mais les données provenant de la Bd ne sont plus stockés sur la feuille crée.[...]

Normalement, on ne devrait pas créer le listobject par code. Il devrait préexister dans un classeur (éventuellement un modèle) que l'on va alimenter par le recordset. Dans le classeur qui contient le tableau (ou dans un autre qui sert "d'application"), on place le code qui:

vide le tableau structuré (listobject);
récupère le recordset;
le transforme en array;
transpose l'array car l'array créé par rs.getRows est "à l'envers" (lignes et colonnes transposées);
transfère l'array sur la plage du tableau structuré redimensionnée.

Si vraiment on doit recréer le tableau structuré (listobject), on remplace le point 1 ci-dessus par : Créer le tableau structuré.

De plus, en procédant ainsi, on travaille avec des petites fonctions et procédures qui ne font qu'une seule chose (chaque étape décrite plus haut), et on les appelle selon la séquence correcte, comme je l'ai illustré dans ma première réponse.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub RetrieveDatas()
  Dim Rows
 
  ClearTable
  Rows = getRows()
  Rows = Transpose(Rows)
  If Not IsEmpty(Rows) Then Range("t_Contacts").Resize(UBound(Rows) + 1).Value = Rows
End Sub
 
Sub ClearTable()
  If Not Range("t_Contacts").ListObject.DataBodyRange Is Nothing Then _
    Range("t_Contacts").ListObject.DataBodyRange.Delete
End Sub
 
Function getRows()
  Dim cn As New ADODB.Connection
  Dim rs As ADODB.Recordset
  Dim FileName As String
  Dim Rows
 
  FileName = "D:\Documents\Database29.accdb"
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & FileName
  Set rs = cn.Execute("select contactpk, firstname, lastname from contact")
  If Not rs.EOF Then getRows = rs.getRows()
  rs.Close
  cn.Close
End Function
 
Function Transpose(Rows)
  Dim i As Long, j As Long
  ReDim t(UBound(Rows, 2), UBound(Rows))
 
  For i = 0 To UBound(Rows)
    For j = 0 To UBound(Rows, 2)
      t(j, i) = Rows(i, j)
    Next
  Next
  Transpose = t
End Function

Si vraiment on doit créer le listobject, on utilise une procédure qui le crée et on n'a plus besoin de le vider au début de la procédure RetrieveDatas. Et si vraiment on doit créer une nouvelle feuille, on le fait avant d'y créer le tableau structuré, toujours au moyen d'une fonction dont l'unique travail est de créer la feuille et de lui donner un nom.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub CreateListObject(sh As Worksheet, Name As String, Columns)
  Dim ls As ListObject
  Dim Counter As Long
 
  Set ls = sh.ListObjects.Add(xlSrcRange, sh.Range("a1").Resize(1, UBound(Columns) - LBound(Columns) + 1))
  ls.Name = Name
  For Counter = 1 To (UBound(Columns) - LBound(Columns) + 1)
    ls.ListColumns(Counter).Name = Columns(Counter - 1)
  Next
End Sub

Mais je répète que normalement, le classeur de destination doit préexister et être créé à la main, éventuellement sous format xlTx ou xlTm selon qu'il contiendra ou non des macros. Ca permet de poser le cadre de travail sans réinventer la roue en créant le classeur par code.

**fochive** · 05/12/2019, 11h57

Je vous remercie pour votre aide mais étant débutant , je ne comprend vraiment rien à vos explications.

Pouvez vous me donner une instruction svp pour que quand le feuille existe déjà ça suprime la feuille existante et crée une nouvelle feuille ?

**Pierre Fauconnier** · 05/12/2019, 13h05

C'est justement parce que tu es débutant que tu as intérêt à apprendre de suite les bonnes pratiques. De plus, ce que tu te proposes de réaliser n'est pas un code de débutant: Aller rechercher des données en SQL, les placer dans un tableau que tu crées sur une feuille que tu crées, ça n'a rien de "débuter en VBA".

Voici un code qui supprime une feuille dont tu connais le nom et qui renvoie True si la feuille a pu être supprimée. Même cela, ça nécessite un peu de code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function DeleteSheet(Name As String) As Boolean
  Dim Counter As Long: Counter = 1
 
  On Error GoTo EndHandler
  Do While Counter <= Worksheets.Count And Not DeleteSheet
    If StrComp(Worksheets(Counter).Name, Name, vbTextCompare) = 0 Then
      Application.DisplayAlerts = False
      Worksheets(Counter).Delete
      DeleteSheet = True
    End If
    Counter = Counter + 1
  Loop
 
EndHandler:
    Application.DisplayAlerts = False
End Function

Bien sûr, le code de bouseux Worksheets(Name).delete pourrait convenir, mais si la feuille n'existe pas (elle a déjà été supprimée, le nom est mal orthographié, ...), tu vas lever une exception et entrer en mode débogage. Tu pourrais aussi utiliser le code suivant, mais perso, je n'aime pas programmer "par l'erreur" (qui lève en fait une exception, ce qui n'est pas "banal" en terme de gestion du thread par le processeur), et je pense que si tu veux te prémunir des bugs, tu dois apprendre à bien coder. En te créant des procédures génériques paramétrées (que tu peux stocker dans un module à part, une sorte de boite à outils que tu réutilises dans chaque projet), tu gagnes du temps car tu ne réinventes pas la roue et tu utilises des "briques logicielles" qui ont été testées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
  On Error Resume Next
  Worksheets("feuil2").Delete
  On Error GoTo 0

La procédure que tu donnes est trop longue car elle "fait tout". Ce n'est pas comme cela qu'on programme. Si tu regardes le code que j'ai fourni, tu verras que chaque procédure ou fonction réalise une petite étape du processus complet. Il suffit de l'exécuter pas à pas (clique dans la procédure RetrieveDatas puis avancer pas à pas avec F8 pour exécuter chaque ligne de code) pour comprendre ce qu'elle réalise. Qui plus est, c'est en gros de l'anglais de cuisine, donc facilement compréhensible.

Si tu dézippes le fichier que je mets en pièce jointe, tu pourras faire tourner mon code juste pour voir ce qu'il fait. Il faudra bien sûr adapter la valeur de la variable FileName utilisée pour la récupération du fichier Access.

PS: Evite de reprendre tout le message précédent lorsque tu postes, ce n'est pas nécessaire

**Pierre Fauconnier** · 05/12/2019, 16h10

Au passage, je rappelle que Excel possède des outils qui permettent d'aller chercher des données ailleurs (Sql, Access, XML, json, txt, csv, ...) directement sans aucune ligne de code (Power Query, bien sûr, mais aussi MSQuery pour les versions plus anciennes, ainsi que les "anciens" outils de connexion au données, toujours présents mais caché dans les commandes non présentes sur le ruban).

Avec les versions actuelles d'Excel, il est de moins en moins utile d'utiliser VBA pour récupérer des données externes, mais c'est "au prix" d'une bonne conception des fichiers en amont

**fochive** · 06/12/2019, 11h37

Merci beaucoup pour votre détermination à m'aider

mais c'est pas très évident

**Pierre Fauconnier** · 06/12/2019, 11h48

Je t'ai mis un fichier zip d'exemple. Si tu adaptes le contenu de la variable Filename pour préciser où tu as déposé le fichier Access d'exemple, tu peux exécuter le code pas à pas, ce qui te permettra d'en comprendre chaque ligne lors de l'exécution.

Perso, je préfère du code découpé de cette manière que la longue macro que tu as proposée en entame de la discussion, et je répète le code que je propose fait l'essentiel, à savoir récupérer des données d'un recordset sql. La construction du classeur, et notamment du tableau structuré, ne doit normalement pas être réalisée en VBA, ce qu'illustre mon propos.

Nul doute qu'il y a moyen de réaliser cela autrement, notamment sans architecturer son code en procédures/fonctions. Perso, je pense qu'apprendre le VBA (et la programmation) de cette manière n'est pas une bonne chose, car cela met en place des mauvaises pratiques, tant pour l'approche que pour le code lui-même.

Je suis bien conscient que "c'est pas évident", mais ton problème n'est pas un problème de débutant.

Courage!

Ajouter uniquement une seule feuille en VBA

Macros et VBA Excel

Discussions similaires

Partager

Partager