> 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
539,94 €Mini PC MINISFORUM EliteMini X400 (Ryzen 5 Pro 4650G, 16Go RAM, 512Go SSD) à 539,94 €
Valable jusqu'au 22 Janvier

GeekBuying fait une belle promotion le mini PC MINISFORUM EliteMini X400 qui passe à 539,94 € avec le code promo NNNMINISFORUM au lieu de 729 €. Ce mini PC au format NUC d'Intel est extrêmement bien équipé. Il possède un processeur AMD Ryzen 5 Pro 4650G 6 coeurs  (3.6 à 4.4 GHz) avec chip graphique Vega 7, 16 Go de RAM DDR4 et un SSD NVMe de 512 Go. Il dispose d'une connectique complète : un emplacement 2,5 pouces libre (pour ajouter un disque dur ou un SSD supplémentaire), le WiFi6, le bluetooth 5.0, 4 ports USB 3.0, un port HDMI 2.0, un DisplayPort, un port Ethernet Gigabit, un lecteur de carte MicroSD et tourne sous Windows 10 Pro que vous pourrez mettre en français au premier démarrage.

Branchez ce mini PC sur une TV ou un écran et vous avez un ordinateur discret et très performant (bureautique, multimédia, jeux en HD).

Cet ordinateur est expédiée depuis un entrepôt allemand. Vous êtes ainsi certains d'être livré rapidement et de ne pas avoir de douane.


> Voir l'offre
51,99 €Barre de son bluetooth Philips TAB5105 à 51,99 €
Valable jusqu'au 22 Janvier

Cdiscount fait une promotion sur la barre de son bluetooth Philips TAB5105 qui passe à 51,99 € alors qu'on la trouve ailleurs à partir de 80 €. Cette barre de son intègre 2 haut-parleurs 2x15W et peut lire vos musiques sans fil via Bluetooth. Une entrée audio jack 3.5 mm et optique TOSLINK sont également présentes. Compatible HDMI ARC, vous pourrez contrôler la barre de son à l'aide de la télécommande de votre téléviseur. Elle est suffisamment fine pour se glisser sous la plupart des téléviseurs. Vous pouvez également la fixer au mur à l'aide des supports intégrés.


> Voir l'offre
15,97 €Carte mémoire SDXC SanDisk Extreme 64 Go à 15,97 €
Valable jusqu'au 25 Janvier

Fnac fait une promotion sur la carte mémoire SDXC SanDisk Extreme 64 Go à 15,97 €. Cette carte mémoire est certifiée classe 10 U3 et autorise des débits de 70 Mo/s en capture et 150 Mo/s en transfert.


> 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