> Tous les forums > Forum Bureautique
 VBA Excel - création onglet avec Worksheet_ChangeSujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
dry007
  Posté le 25/04/2012 @ 14:31 
Aller en bas de la page 
Petit astucien

salut, salut!

encore une fois je viens faire appel aux spécialistes parce que j'en aimarre de m'arracher les cheveux!

plantons le décors:

-> une procédure Excel qui doit me créer dynamiquement un onglet et générer la Worksheet_Change associée

-> le code:

Sub creerOnglet(ByVal nom As String, ByVal couleur As Integer)

Sheets.Add Worksheets(1)
Sheets(1).Name = nom
ActiveWorkbook.Sheets(nom).Tab.ColorIndex = couleur

Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
Code = Code & "Dim c As Range" & vbCrLf
Code = Code & "For Each c In Target" & vbCrLf
Code = Code & " Sheets(" & nom & ").Range(""H"" & c.Row).Select" & vbCrLf
Code = Code & " Selection.FormatConditions.Delete" & vbCrLf
Code = Code & " Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=Sheets(""DATA"").Range(""L16"").Value" & vbCrLf
Code = Code & " Selection.FormatConditions(1).Interior.ColorIndex = 3" & vbCrLf
Code = Code & "Next c" & vbCrLf
Code = Code & "End Sub"
With ActiveWorkbook.VBProject.VBComponents(Sheets(nom).CodeName).CodeModule
.InsertLines .CountOfLines + 1, Code
End With

End Sub

-> l'erreur: erreur d'exécution 9 - l'indice n'appartient pas à la sélection

-> ce qui voudrait donc dire que Sheets(nom) n'existe pas en somme

or, l'onglet en question vient d'être crée par le code 10 lignes plus haut, et il est bien visible dans mon classeur(????).........

une idée peut être?

merci.

Publicité
gilbert_rgi
 Posté le 25/04/2012 à 16:16 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

bonjour

comme ceci peut-être

Sub test()
nom = "Marcel"
couleur = RGB(255, 0, 0)
Sheets.Add Worksheets(1)
Sheets(1).Name = nom
Sheets(nom).Tab.Color = couleur

Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
Code = Code & "Dim c As Range" & vbCrLf
Code = Code & "For Each c In Target" & vbCrLf
Code = Code & " Sheets(" & Chr$(34) & nom & Chr$(34) & ").Range(""H"" & c.Row).Select" & vbCrLf
Code = Code & " Selection.FormatConditions.Delete" & vbCrLf
Code = Code & " Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=Sheets(""DATA"").Range(""L16"").Value" & vbCrLf
Code = Code & " Selection.FormatConditions(1).Interior.ColorIndex = 3" & vbCrLf
Code = Code & "Next c" & vbCrLf
Code = Code & "End Sub"
With ActiveWorkbook.VBProject.VBComponents(Sheets(nom).CodeName).CodeModule
.InsertLines .CountOfLines + 1, Code
End With

End Sub

OU

Dim nom As String
Dim couleur As Integer

Public Sub test()
creerOnglet "Paul", 3
End Sub
Public Sub creerOnglet(nom, couleur)
Sheets.Add Worksheets(1)
Sheets(1).Name = nom
Sheets(nom).Tab.ColorIndex = couleur
Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
Code = Code & "Dim c As Range" & vbCrLf
Code = Code & "For Each c In Target" & vbCrLf
Code = Code & " Sheets(" & Chr$(34) & nom & Chr$(34) & ").Range(""H"" & c.Row).Select" & vbCrLf
Code = Code & " Selection.FormatConditions.Delete" & vbCrLf
Code = Code & " Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=Sheets(""DATA"").Range(""L16"").Value" & vbCrLf
Code = Code & " Selection.FormatConditions(1).Interior.ColorIndex = 3" & vbCrLf
Code = Code & "Next c" & vbCrLf
Code = Code & "End Sub"
With ActiveWorkbook.VBProject.VBComponents(Sheets(nom).CodeName).CodeModule
.InsertLines .CountOfLines + 1, Code
End With

End Sub



Modifié par gilbert_rgi le 25/04/2012 16:39
dry007
 Posté le 25/04/2012 à 16:42 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

ok, merci de ta participation, MAIS tu pourrais mettre en évidence les différences entre ton code et le mien STP?

pas évident du tout là, et ecrit vraiment petit.

merci.



Modifié par dry007 le 25/04/2012 16:43
gilbert_rgi
 Posté le 25/04/2012 à 16:50 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

dry007 a écrit :

ok, merci de ta participation, MAIS tu pourrais mettre en évidence les différences entre ton code et le mien STP?

pas évident du tout là, et ecrit vraiment petit.

merci.

pour voir plus gros

selectionner le code touche ctrl appuyée puis tourner la roulette de la souris


gilbert_rgi
 Posté le 25/04/2012 à 16:58 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Dim nom As String

Dim couleur As Integer

'procédure de lancement

Public Sub test()

creerOnglet "Paul", 3

End Sub

Public Sub creerOnglet(nom, couleur)

Sheets.Add Worksheets(1)

Sheets(1).Name = nom

Supprimé activeworkbook Sheets(nom).Tab.ColorIndex = couleur

Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf

Code = Code & "Dim c As Range" & vbCrLf

Code = Code & "For Each c In Target" & vbCrLf

Code = Code & " Sheets(" & Chr$(34) & nom & Chr$(34) & ").Range(""H"" & c.Row).Select" & vbCrLf

Code = Code & " Selection.FormatConditions.Delete" & vbCrLf

Code = Code & " Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=Sheets(""DATA"").Range(""L16"").Value" & vbCrLf

Code = Code & " Selection.FormatConditions(1).Interior.ColorIndex = 3" & vbCrLf

Code = Code & "Next c" & vbCrLf

Code = Code & "End Sub"

With ActiveWorkbook.VBProject.VBComponents(Sheets(nom).CodeName).CodeModule

.InsertLines .CountOfLines + 1, Code

End With

End Sub

dry007
 Posté le 26/04/2012 à 09:06 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

ah ben voilà!

merci.

ok je vais voir ça, mais sans vendre la charrue avant la peau des ours, à priori, des globales + une concaténation de chaines différente en devraient pas être si signficatives.

car précision (pour moi CT clair, mais desfois que...):

-> l'erreur que je signale & qui pose problème est générée par la ligne de code fluotée

-> ce n'est pas le montage du code qui pose problème, c'est bien l'association à l'onglet, puisque je répète que physiquement l'onglet "nom" est bien crée, je le vois dans mon classeur

de plus, selon les versions (2003 pour moi) il est possible qu'il faille activer Menu Outils -> Macro -> Sécurité -> Onglets Sources fiables -> Cocher "Faire confiance au projet Visual Basic.

mais je vais tester malgré tout et je dirai ce qu'il en est.

@+

dry007
 Posté le 26/04/2012 à 09:57 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

ok, ok... bon, sur ce coup j'aurais préféré me tromper, mais effectivement ça ne change rien! {#}

en tout cas chez moi...

gilbert_rgi
 Posté le 26/04/2012 à 18:35 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

-> l'erreur que je signale & qui pose problème est générée par la ligne de code fluotée

non cette ligne ne cause aucun problème

Mytå
 Posté le 26/04/2012 à 23:03 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut le forum

Code tester sous Excel 2003 sans aucune erreur.

Option Explicit

Public Sub test()
creerOnglet "Paul", 3
End Sub

Sub creerOnglet(ByVal Nom As String, ByVal Couleur As Integer)
Dim Code As String

Sheets.Add Worksheets(1)
Sheets(1).Name = Nom
ActiveWorkbook.Sheets(Nom).Tab.ColorIndex = Couleur

Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
Code = Code & "Dim c As Range" & vbCrLf
Code = Code & "For Each c In Target" & vbCrLf
Code = Code & " Sheets(""" & Nom & """).Range(""H"" & c.Row).Select" & vbCrLf
Code = Code & " Selection.FormatConditions.Delete" & vbCrLf
Code = Code & " Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=Sheets(""DATA"").Range(""L16"").Value" & vbCrLf
Code = Code & " Selection.FormatConditions(1).Interior.ColorIndex = 3" & vbCrLf
Code = Code & "Next c" & vbCrLf
Code = Code & "End Sub"

With ActiveWorkbook.VBProject.VBComponents(Sheets(Nom).CodeName).CodeModule
.InsertLines .CountOfLines + 1, Code
End With

End Sub

Le fichier : Dry007.xls

Mytå



Modifié par Mytå le 26/04/2012 23:55
gilbert_rgi
 Posté le 27/04/2012 à 18:12 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Bonjour et merci Mytå

Mytå
 Posté le 27/04/2012 à 23:34 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Re le forum

Merci Gilbert, car Dry007 passe vraiment en coup de vent pour les remerciements.

«RESOLU (27/04/2012 à 08:56)»

Mytå

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
119,99 €SSD Crucial P5 Plus 1 To (3D NAND, NVMe, PCIe 4.0, M.2, 6600 Mo/s) à 119,99 €
Valable jusqu'au 22 Mai

Amazon fait une promotion sur le SSD Crucial P5 Plus 1 To (3D NAND, NVMe, PCIe 4.0, M.2) qui passe à 119,99 € livré gratuitement. On le trouve ailleurs à partir de 160 €. Ce SSD offre des vitesses de lecture/écriture séquentielle allant jusqu’à 6600/ 3 000 Mo/s. Il est garanti 5 ans.

Cette version Plus est compatible PCIe 4.0. Vous pouvez donc aussi l'utiliser avec la console de jeux PS5.


> Voir l'offre
-10 €-10 € dès 25 € pour une première livraison en point de retrait Amazon (selon éligibilité)
Valable jusqu'au 24 Mai

Amazon propose actuellement 10 euros de remise dès 25 euros d'achats avec le code 10RETRAIT pour une première livraison en point de retrait Amazon. 


> Voir l'offre
99,99 €SSD externe NVMe Crucial X8 1 To à 99,99 €
Valable jusqu'au 22 Mai

Amazon fait une promotion sur le SSD externe NVMe Crucial X8 1 To qui passe à 99,99 € alors qu'on le trouve ailleurs à partir de 135 €. Il offre des vitesses de lecture jusqu'à 1050 Mo/s et résiste aux chutes jusqu'à 2 mètres, aux chocs et aux températures extrêmes. Il est fourni avec des connecteurs USB C-3.2 et USB-A (USB classique).


> Voir l'offre

Sujets relatifs
création d'un répertoire avec Word ou excel
Faire un tableau sur Excel avec des sauts de lignes
Creation d' une boucle macro dans fichier EXCEL pour impression
Excel 2013 - Création pyramide des Ages
[Plus de clic droit sur onglet Excel]
Excel ne peut pas terminer cette tâche avec erreur de ressources disponible
Excel ne peut pas terminer cette tâche avec erreur de ressources disponible
Impression avec Excel Wiewerr
transfert de fichiers excel word sur tablette avec Android
Fichier .csv avec Excel
Plus de sujets relatifs à VBA Excel - création onglet avec Worksheet_Change
 > Tous les forums > Forum Bureautique