[VBA-Excel] Macro Création Case à cocher

Version imprimable

Bonjour,
J'ai un problème depuis une journée sur une macro qui me permettrait de compléter un document avec 200 onglets.
Il faut que je rajoute deux cases à cocher dans chaque onglet.
Donc je me suis dit pourquoi pas faire un nouvelle macro qui ferais les 200 onglets vite fait (le contenu des onglets sont les mêmes)
Puis après il faut que je lie chaque case sur un document de rapport :
Par exemple Onglet 1 :
-Case a cocher 1 -> liés a la case I2
-Case a cocher 2 -> liés a la case J2
Onglet 2
-Case a cocher 3 -> liés a la case I3
-Case a cocher 4 -> liés a la case J3
Etc ..

Voici le début de mon code :
Code:

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 Sub Case_cocher() For i = 1 To 200 Sheets("" & i).Select ActiveSheet.CheckBoxes.Add(456, 16.5, 51, 24).Select ActiveSheet.Shapes("Check Box " & j).Select Selection.Characters.Text = "Nouveau Domaine" Selection.ShapeRange.ScaleWidth 1.97, msoFalse, msoScaleFromTopLeft With Selection .Value = xlOff .LinkedCell = "Récap!$J$" & i .Display3DShading = False End With Next i For j = 1 To 2000 Sheets("" & j).Select ActiveSheet.CheckBoxes.Add(591.75, 14.25, 85.5, 30).Select ActiveSheet.Shapes("Check Box " & j).Select Selection.Characters.Text = "Domaine Renégocié" Selection.ShapeRange.ScaleWidth 1.24, msoFalse, msoScaleFromTopLeft With Selection .Value = xlOff .LinkedCell = "Récap!$K$" & j .Display3DShading = False End With Next j End Sub
J'ai déjà une erreur de compilation sur :

Code:

ActiveSheet.CheckBoxes.Add(456, 16.5, 51, 24).Select

Merci d’avance pour vôtre aide

Personne ne peut m'aider ?

il faut éviter les select, activeSheet....selection ...qui sont des source d'erreurs...écrit plutôt un truc du genre !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Dim chk As CheckBox
For i = 1 To 200
 
   Set chk = Sheets(i).CheckBoxes.Add(456, 16.5, 51, 24)
   With chk
        .Text = "Nouveau Domaine"
        .ShapeRange.ScaleWidth 1.97, msoFalse, msoScaleFromTopLeft
        .Value = xlOff
        .LinkedCell = "Récap!$J$" & i
        .Display3DShading = False
    End With
   Set chk = Sheets(i).CheckBoxes.Add(591.75, 14.25, 85.5, 30)
   With chk
        .Text = "Domaine Renégocié"
        .ShapeRange.ScaleWidth 1.24, msoFalse, msoScaleFromTopLeft
        .Value = xlOff
        .LinkedCell = "Récap!$k$" & i
        .Display3DShading = False
    End With
Next
End Sub

18/07/2006, 15h05
strifer

erreur d'éxecutions 1004 sur :

Code:

Set chk = Sheets(i).CheckBoxes.Add(456, 16.5, 51, 24)

Impossible de lire la propriété Add de la Classe Checkboxes

Même genre d'erreur que tout à l'heure.

En tout cas merci pour ton aide.
18/07/2006, 15h16
SfJ5Rpw8

et dans ton classeur tu n'as que des feuilles de calculs ( pas des graphiques...? ou feuille de dialogue Excel 5.0)...?
18/07/2006, 15h20
strifer

Le classeur ce présente ainsi :

Un Onglet Récap qui récapitule tout ce qui est présent dans les autres onglets.

Puis 200 onglets numérotés de 1 à 200 :
Dans ces onglets, titre Action 1 à 200.
Dan chaque onglets il n'y a que des calculs qui sont liés à la feuille Récap.
18/07/2006, 15h25
SfJ5Rpw8
essai de voir la valeur de i au moment du plantage... par exemple en rajoutant .. :
Code:

1 2 3 debug.print "Traitement " & i & " .. feuille : " & sheets(i).name Set chk = Sheets(i).CheckBoxes.Add(456, 16.5, 51, 24)
puis aprés le l'arrêt voir les messages dans fenêtre exécution (CTRL G)
18/07/2006, 15h39
strifer

Il ne fait pas une boucle entière
i = 1
18/07/2006, 15h40
SfJ5Rpw8

et le nom de la feuille .?
18/07/2006, 15h42
strifer

Récap, effectivement il doit y avoir un problème.
Car il ne va pas sur la feuille 1.
18/07/2006, 15h44
SfJ5Rpw8

tes feuilles s'appellent 1 , 2, ...200..?

il faut peut-être alors remettre les "" que j'ai enlevé...:?

Code:

....Sheets("" & i)...
18/07/2006, 15h49
strifer

Mdr je n'avais même pas vu que tu les avais pas mit.
De toute façon, même érreur.
18/07/2006, 15h51
SfJ5Rpw8

Citation:

Envoyé par strifer

Mdr je n'avais même pas vu que tu les avais pas mit.
De toute façon, même érreur.

toujours sur la feuille récap ..? ...

et elle est lancé d'ou ta macro ..?
18/07/2006, 16h02
strifer

Non feuille 1
mais toujours même erreur.
19/07/2006, 08h47
strifer

Bizarre que ça fasse toujours le même problème.
19/07/2006, 08h49
SfJ5Rpw8

ben tu lance ta macro d'ou..? as tu essayer d'inserer "manuellement" une case à cocher dans la dite feuille..?
19/07/2006, 09h50
strifer

ups

Je viens de comprendre, mon maitre de stage ne m'avait pas dit que sur le nouveau fichier qu'il m'avait donné, chaque onglet était protégé par un mot de passe. (donc au final ca marchait depuis le début :( )
Sinon peut être une solution pour enlever tout les mots de passes d'un coup ? (outils>Protection>oter la protection est grisé quand on selectionne tout les onglets)

Il y a aucune option qui permettent de supprimer les protections en un seul coup ?

Grrr firefox me fait n'imp.
Il met une plombe a afficher une page et quand elle est affiché il m'a mi 3 réponse.(j'appuy qu'une fois pourtant)
19/07/2006, 16h16
SfJ5Rpw8
il n'y as pas moyen d'enlever les protections "d'un seul coup" mais tu peu les enlever avant de poser ta case à cocher puis les remettre ensuite... rajoute ces lignes à la boucle vu plus haut
Code:

1 2 3 4 5 6 7 8 9 For i = 1 To 200 Sheets(i).Unprotect bbil Set chk = Sheets(i).CheckBoxes.Add(456, 16.5, 51, 24) ( .... ... ) Sheets(i).protect bbil Next i ...
PS : J'ai considéré que le mot de passe été le même pour toutes les feuilles et que ton maitre avez utilisé bbil :mouarf:
20/07/2006, 08h46
strifer

:D
Merci je vais tester ça tout de suite.
Manqué ce n'étais pas Bbil :lol:

Edit: j'avais essayé un truc dans le genre mais ça n'avais pas marché, voyons voir si cette fois est la bonne.

En tout cas merci, pour vôtre aide.

EDIT :
Bizarre, il me dit que le mot de passe est mauvais et que je vérifie ma touche maj
Et en mettant ce même mot de passe dans la fenêtre oter la protection, ça marche. 8O
J'ai modifié un peu le code j'ai rajouté les "" avant le i

Code:

Sheets("" & I).Unprotect ce n'est pas Bibil
20/07/2006, 08h58
Elstak

Citation:

Envoyé par bbil

PS : J'ai considéré que le mot de passe été le même pour toutes les feuilles et que ton maitre avez utilisé bbil :mouarf:

Bah oui, biensur qu'il a utilisé bbil ! qu est ce que tu voulais qu'il mette d'autre?? :mouarf:

Ca va sinon ta tete petit renard? elle enfle pas de trop ? :mouarf:
20/07/2006, 09h07
SfJ5Rpw8

enfait ecrit comme cela :

Code:

Sheets("" & i).Unprotect bbil

bbil n'est pas le mot de passe mais une variable contenant le mot de passe si bbil est le mot de passe tu peu écrire

Code:

Sheets("" & i).Unprotect "bbil"

:mouarf:
20/07/2006, 09h10
strifer

Ok, merci heureusement que tu es là :mrgreen:

Edit: ça marche enfin.

Donc le problème est résolu

Merci encore

Re bonjour,

Je viens de me rendre compte qu'il ne s'agit pas de la bonne case à cocher :cry:

Voici le bon code pour créer cette case :

Code:

1
2
3
 
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=524, Top:=302, Width:=197, Height:=35). _

Comment adapter ce code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
 
Dim chk As CheckBox
For I = 1 To 200
 
    Set chk =Sheets("" & I).CheckBoxes.Add(285.75, 204, 96, 24.75)
   With chk
        .Text = "Revalorisation de tarif"
        .Value = xlOff
        .LinkedCell = "Récap!$k$" & I + 1
        .Display3DShading = False
        .ShapeRange.Fill.Visible = msoTrue
        .ShapeRange.Fill.Solid
        .ShapeRange.Fill.ForeColor.SchemeColor = 52
        .ShapeRange.Fill.Transparency = 0#
        .ShapeRange.Line.Weight = 0.5
        .ShapeRange.Line.DashStyle = msoLineSolid
        .ShapeRange.Line.Style = msoLineSingle
        .ShapeRange.Line.ForeColor.SchemeColor = 64
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
 
 
    End With

Afin que cette nouvelle case, puisse être créer, mise en forme et positionner automatiquement.

Merci encore.

21/07/2006, 08h59
strifer
Code:

1 2 Dim chk As CheckBox For I = 1 To 200
Je l'ai modifié en :
Code:

1 2 Dim chk As OLEObjects For I = 1 To 200
Ca me fait déjà pas la même erreur ....

Il me dit :
Incompatibilité de Type :cfou:

EDIT: je tiens a signaler qu'il place quand même une box, que ce soit avant changement et après.

Pour le moment je vois pas trop.....

A moins que vous ayez une solution pour grossir la taille du texte dans le premier checkbox.
Celui-ci :

Code:

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
Dim chk As CheckBox
For I = 1 To 200
 
 
    Sheets("" & I).Unprotect "pasbbil"
 
   Set chk = Sheets("" & I).CheckBoxes.Add(456, 16.5, 51, 24)
   With chk
 
 
 
        .Text = "Nouveau Domaine"
        .ShapeRange.ScaleWidth 1.97, msoFalse, msoScaleFromTopLeft
        .Value = xlOff
        .LinkedCell = "Récap!$J$" & I + 1
        .Display3DShading = False
        .ShapeRange.Fill.Visible = msoTrue
        .ShapeRange.Fill.Solid
        .ShapeRange.Fill.ForeColor.SchemeColor = 52
        .ShapeRange.Fill.Transparency = 0#
        .ShapeRange.Line.Weight = 0.5
        .ShapeRange.Line.DashStyle = msoLineSolid
        .ShapeRange.Line.Style = msoLineSingle
        .ShapeRange.Line.ForeColor.SchemeColor = 64
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
        .ShapeRange.IncrementLeft -397.5
        .ShapeRange.IncrementLeft 2.25
        .ShapeRange.IncrementTop 188.25
        .ShapeRange.ScaleWidth 1.02, msoFalse, msoScaleFromBottomRight
        .ShapeRange.ScaleWidth 0.99, msoFalse, msoScaleFromBottomRight
 
 
 
        End With
 
 Sheets("" & I).Protect "Pasbbil"