Dimentionner une CheckBox par code

**johannj** · 16/07/2010, 16h29

Bonjour le forum,
cette discussion fait suite au post "Ajout de OLEObjects".

J'arrive maintenant à mettre une checkbox à chaque fois que j'insère une ligne.
Mon problème est maintenant le suivant: je souhaite régler les dimensions de la checkbox. Le code est le suivant:

Code :

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

1
2
3
4
5
6
7
8
Sub test()
    With Worksheets(1)
 
    For k = 1 To 3
        .Range("B" & k).Select
        Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Width:=10)
    Next k
End With

on peut aussi mettre le code suivant:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
    With Worksheets(1)
 
    For k = 1 To 3
        .Range("B" & k ).Select
        Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)
        With Obj
            .width = 10
            .Object.Caption = ""
        End With
    Next k
End With

le code fonctionne bien pour l'insertion de la checkbox, mais dès que je mets la ligne concernant la largeur de la box, la macro me place toutes les checkbox dans la cellule A1

, bien que je sélectionne la colonne B??

Avez vous une idée please??

Mercipar avance,
Johann

PS: au passage, à quoi sert le Link lors de l'ajout de la checkbox?

**johannj** · 16/07/2010, 16h45

Je reviens vers vous encore une fois

!!
Alors, le petit code ci dessus fonctionne bien (excepté l'erreur décrite: à savoir, toutes les checkbox se retrouve en A1), mais si je l'insère dans ma "vrai macro", il y a bug!!

le code la macro est le suivant:

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
63
64
65
Option Explicit

Sub reflectivité()
    Dim WB As Workbook
    Dim Openreference As Variant
    Dim a As Integer, dl As Integer, dc As Integer, i As Integer,  j As Integer, pas As Integer
    Dim min As Integer, max As Integer
    Dim  somme As String
    Dim photonpas As Single, somme1 As Single, photonpasref As Single, somme2 As Single, refeff  As Single
    Dim Obj As OLEObjects
    
    Set WB = ThisWorkbook
    
    min = InputBox("Longueur d'onde minimale en nm:")
    max = InputBox("Longueur d'onde maximale en nm:")
    
    With WB.Worksheets(3)
        dl = .Range("A1000").End(xlUp).Row 'cherche le nombre de ligne
        dc = .Range("DD2").End(xlToLeft).Column 'cherche le nombre de colonne
        pas = .Cells(dl - 1, 1).Value - .Cells(dl, 1).Value
        .Range(.Cells(3, 1), .Cells(dl, dc)).Sort Key1:=.Cells(3, 1), Order1:=xlAscending, Header:=xlGuess
        
        a = 2
        j = 1
        While a <= dc
            i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1)))
                For i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1))) To Application.WorksheetFunction.Match(max, .Range(.Cells(1, 1), .Cells(dl, 1)))
                    photonpas = pas * (WB.Worksheets(4).Cells(i, 2).Value)
                    photonpasref = pas * (WB.Worksheets(4).Cells(i, 2).Value) * (WB.Worksheets(3).Cells(i, a).Value)
                    If i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1))) Then
                        somme1 = photonpas
                        somme2 = photonpasref
                    Else
                        somme1 = somme1 + photonpas
                        somme2 = somme2 + photonpasref
                    End If
                Next i
             
            WB.Worksheets(2).Cells(j, 3).Value = (somme2 / somme1) / 100
            
            WB.Worksheets(2).Range("D" & j).Select
            Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)

                Obj.Object.Caption = " "

            j = j + 1
            a = a + 2
        Wend
        
        .Cells.NumberFormat = "0.00"
        .Cells.EntireColumn.AutoFit
    End With
    
    With WB
         With Worksheets(2)
 
            .Rows("1:1").Insert   
            .Columns(3).NumberFormat = "0.0%"
            .Cells.EntireColumn.AutoFit
            .Rows(1).Font.Bold = True
            .Select
        End With
        
    End With
End Sub

une erreur survient :
-la première est une incompatibilité de type, qui apparait uniquement si je mets les lignes en rouges dans le code.

Merci d'avance pour votre aide,
Johann

**mercatog** · 16/07/2010, 16h48

Code :

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

1
2
3
4
5
6
7
8
9
10
11
With Worksheets(1)
    For k = 1 To 3
        Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)
        With Obj
            .Top = (k - 1) * 18
            .Left = 200
            .Width = 100
            .Object.Caption = ""
        End With
    Next k
End With

**johannj** · 16/07/2010, 17h08

Merci mercatog pour la réponse,

Merci pour le code, mais je ne comprends pas pourquoi dans mon code, les checkbox se décalaient et ne se plaçaient pas dans la colonne C

par contre, j'ai toujours une erreur dans ma macro, la grande, si je mets les lignes en rouges (que j'ai rempalcé par ton code!!
Il y a incompatibilité de type!!

J'avoue ne pas avoir d'idée du tout

!!
Johann

**mercatog** · 16/07/2010, 17h18

mets ceci

Code :

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

WB.Worksheets(2).Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False) 'ou le 2ème code fourni

si ton code en sheets(3) et tu veux insérer tes chckbox en sheets(2)

Edit: mea culpa

**johannj** · 16/07/2010, 17h25

En effet, je travaille sur la feuille 3 mais je veux insérer la box en feuille 2.
J'ai donc séparer le code comme suit:

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
With WB
        With Worksheets(3)
            dl = .Range("A1000").End(xlUp).Row 'cherche le nombre de ligne
            dc = .Range("DD2").End(xlToLeft).Column 'cherche le nombre de colonne
            pas = .Cells(dl - 1, 1).Value - .Cells(dl, 1).Value
            .Range(.Cells(3, 1), .Cells(dl, dc)).Sort Key1:=.Cells(3, 1), Order1:=xlAscending, Header:=xlGuess
 
            a = 2
            j = 1
            While a <= dc
                i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1)))
                    For i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1))) To Application.WorksheetFunction.Match(max, .Range(.Cells(1, 1), .Cells(dl, 1)))
                        photonpas = pas * (WB.Worksheets(4).Cells(i, 2).Value)
                        photonpasref = pas * (WB.Worksheets(4).Cells(i, 2).Value) * (WB.Worksheets(3).Cells(i, a).Value)
                        If i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1))) Then
                            somme1 = photonpas
                            somme2 = photonpasref
                        Else
                            somme1 = somme1 + photonpas
                            somme2 = somme2 + photonpasref
                        End If
                    Next i
 
                WB.Worksheets(2).Cells(j, 3).Value = (somme2 / somme1) / 100
 
                j = j + 1
                a = a + 2
            Wend
 
            .Cells.NumberFormat = "0.00"
            .Cells.EntireColumn.AutoFit
        End With
 
        With Worksheets(2)
 
            For j = 1 To .Range("A1000").End(xlUp).Row
                .Range("D" & j).Select
 
                Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)
                     With Obj
                         .Width = 10
            '            '.Left = 70
                        .Object.Caption = ""
                     End With
            Next j
            .Rows("1:1").Insert
            .Range("A1:C1") = Array("Fichier", "Emplacement", "Reff (" & min & " - " & max & " nm) [%]")
            .Range("C1").Characters(2, 3).Font.Subscript = True
 
            .Columns(3).NumberFormat = "0.0%"
            .Cells.EntireColumn.AutoFit
            .Rows(1).Font.Bold = True
            .Select
        End With
 
    End With

et çà ne marche toujours pas. Soit j'ai une erreur de type 13, incompatibilité, soit une erreur de type 1004: impossible de sélectionner le range("D" & j)??

Bref, ca coince toujours!!

**mercatog** · 16/07/2010, 19h36

Les indentations sont utiles pour se repérer
Si tu travailles avec un seul classeur, tu peux t'en passer de Wb et travailler directement avec les feuilles,
sinon tu devra faire (pour la logique)

Code :

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

1
2
With wb
   With .Worksheets(3)

Aussi, tu ne peux pas sélectionner un range d'une autre feuille autre que la feuille active

Code :

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

1
2
3
4
With Worksheets(2)
 
            For j = 1 To .Range("A1000").End(xlUp).Row
                '.Range("D" & j).Select  !!!A SUPPRIMER

Enfin, Prends l'habitude de déclarer convenablement tes variables au début de la procédure, avec un Option Explicit au début de la page de code.
Une bonne habitude vaut mieux que .... bon je ne sais pas la suite

ton code aura l'allure suivante

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
Option Explicit
Sub Machin()
'-------Déclare Convenablement toutes tes variables
Dim dl As Long
Dim dc As Integer
Dim pas As Double
'----------------------------------
'....début code
With wb
   With .Worksheets(3)
      dl = .Range("A1000").End(xlUp).Row 'cherche le nombre de ligne
      dc = .Range("DD2").End(xlToLeft).Column 'cherche le nombre de colonne
      pas = .Cells(dl - 1, 1).Value - .Cells(dl, 1).Value
      .Range(.Cells(3, 1), .Cells(dl, dc)).Sort Key1:=.Cells(3, 1), Order1:=xlAscending, Header:=xlGuess
 
      a = 2: j = 1
      While a <= dc
         i = Application.WorksheetFunction.Match(Min, .Range(.Cells(1, 1), .Cells(dl, 1)))
         For i = Application.WorksheetFunction.Match(Min, .Range(.Cells(1, 1), .Cells(dl, 1))) To Application.WorksheetFunction.Match(Max, .Range(.Cells(1, 1), .Cells(dl, 1)))
            photonpas = pas * (wb.Worksheets(4).Cells(i, 2).Value)
            photonpasref = pas * (wb.Worksheets(4).Cells(i, 2).Value) * (wb.Worksheets(3).Cells(i, a).Value)
            If i = Application.WorksheetFunction.Match(Min, .Range(.Cells(1, 1), .Cells(dl, 1))) Then
               somme1 = photonpas
               somme2 = photonpasref
            Else
               somme1 = somme1 + photonpas
               somme2 = somme2 + photonpasref
            End If
         Next i
         wb.Worksheets(2).Cells(j, 3).Value = (somme2 / somme1) / 100
         j = j + 1: a = a + 2
      Wend
      .Cells.NumberFormat = "0.00"
      .Cells.EntireColumn.AutoFit
   End With
 
   With .Worksheets(2)
      For j = 1 To .Range("A1000").End(xlUp).Row
         Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)
         With Obj
            .Top = 15 * (j - 1)
            .Width = 10
            .Left = 70
            .Object.Caption = ""
         End With
      Next j
      .Rows("1:1").Insert
      .Range("A1:C1") = Array("Fichier", "Emplacement", "Reff (" & Min & " - " & Max & " nm) [%]")
      .Range("C1").Characters(2, 3).Font.Subscript = True
 
      .Columns(3).NumberFormat = "0.0%"
      .Cells.EntireColumn.AutoFit
      .Rows(1).Font.Bold = True
      .Select
   End With
End With
End Sub

**johannj** · 02/08/2010, 09h43

Bonjour le forum,

Je reviens vers vous concernant l'histoire des checkbox!!
Et bien voilà, le code proposé dans mon dernier message ne fonctionne plus!!!

En effet, la macro me retourne une erreur type 1004: la méthode select de la
classe Range a échoué

.
Je me place pourtant dans la feuille de calcul 2.

Je ne comprends pas pourquoi çà plante

Si vous avez des idées, n'hésitez pas.

Cordialement,
Johann

**johannj** · 02/08/2010, 09h53

Re bonjour le fil,

Bon, après quelques clics sur le net,
j'ai rajouté une ligne dans mon code (la première du code suivant):

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
Worksheets(2).Activate
        With Worksheets(2)
            j = 1
 
            For j = 1 To .Range("A1000").End(xlUp).Row
                Worksheets(2).Range("D" & j).Activate
                Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)
                With Obj
                    .Width = 10
                    .Object.Caption = ""
                End With
            Next j
 
            .Rows("1:1").Insert
            .Range("A1:C1") = Array("Fichier", "Emplacement", "Reff (" & min & " - " & max & " nm) [%]")
            .Range("C1").Characters(2, 3).Font.Subscript = True
 
            .Columns(3).NumberFormat = "0.0%"
            .Cells.EntireColumn.AutoFit
            .Rows(1).Font.Bold = True
            .Select
        End With
 
        chemin_enregistrement = Application.GetSaveAsFilename("Reflectivity resume " & runnumber, ", *.xls")
        WB.SaveAs (chemin_enregistrement)
    End With

Cette fois, il n'y a plus d'erreur, mais je me retrouve avec un Activate, chose que l'on m'a toujours recommander d'éviter

!!

Qu'en pensez vous? N'y a t-il pas un moyen plus "élégant"?

Merci d'avance,
Johann

**mercatog** · 02/08/2010, 10h29

Et si tu mets ton code dans un module général?

**johannj** · 02/08/2010, 10h41

Bonjour Mercatog,

Merci de ta réponse.

Que veux tu dire par "module général"??

Mon code est déjà dans un module.

Mon code entier, dans le module est le suivant:

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 
Option Explicit
 
Sub reflectivité()
    Dim WB As Workbook, Treatedfile As Workbook
    Dim Openreference As Variant
    Dim a As Integer, dc As Integer, i As Integer, numecelvide As Integer, j As Integer, min As Integer, max As Integer
    Dim fichier() As String, chemin_enregistrement As String, somme As String
    Dim runnumber As String
    Dim photonpas As Single, somme1 As Single, photonpasref As Single, somme2 As Single
    Dim Obj As OLEObject
    Dim dl As Long
    Dim pas As Double
 
    Set WB = ThisWorkbook
    WB.Worksheets(4).Visible = False
    Application.ScreenUpdating = False
 
    runnumber = InputBox("N° de run:")
    If runnumber = "" Then Exit Sub
 
    Openreference = Application.GetOpenFilename("", , "Reflectivity File Selection", , True) 'ouverture dela boite de dialogue Open avec filtre et affectation du chemin dans la variable
    If VarType(Openreference) = vbBoolean Then Exit Sub
 
    a = 1: j = 1
 
    For a = 1 To UBound(Openreference)
        Set Treatedfile = Application.Workbooks.Open(Openreference(a)) '(OpenFile, xlMSDOS)
            fichier = Split(Treatedfile.Name, ".")
            WB.Worksheets(2).Cells(a, 1).Value = fichier
            WB.Worksheets(2).Cells(a, 2).Value = Treatedfile.Path
 
            With Treatedfile
                With Worksheets(1)
                    dl = .Range("A1000").End(xlUp).Row 
                    dc = .Range("Z" & dl).End(xlToLeft).Column 
                    numecelvide = .Range("B1").End(xlDown).Row
 
                    If a = 1 Then
                        .Range(.Cells(numecelvide, 1), .Cells(dl, dc)).Copy WB.Worksheets(3).Cells(3, j)
                        WB.Worksheets(3).Cells(2, j + 1).Value = fichier
                        WB.Worksheets(3).Cells(1, j).Value = "Longueur d'onde [nm]"
                        WB.Worksheets(3).Cells(1, j + 1).Value = "Réflectivité mesurée [%]"
                        j = j + 3
                    Else
                        .Range(.Cells(numecelvide, dc), .Cells(dl, dc)).Copy WB.Worksheets(3).Cells(3, j)
                        WB.Worksheets(3).Cells(2, j).Value = fichier
                        j = j + 2
                    End If
                End With
            .Close (False)
            End With
    Next a
 
    ' attribution des valeurs aux bornes pour le calcul de reff
    min = InputBox("Longueur d'onde minimale en nm:", "Borne inférieure pour le calcul de la réflectivité effective")
    max = InputBox("Longueur d'onde maximale en nm:", "Borne supérieure pour le calcul de la réflectivité effective")
 
    With WB
        With Worksheets(3)
            dl = .Range("A1000").End(xlUp).Row 'cherche le nombre de ligne
            dc = .Range("DD2").End(xlToLeft).Column 'cherche le nombre de colonne
            pas = .Cells(dl - 1, 1).Value - .Cells(dl, 1).Value
            .Range(.Cells(3, 1), .Cells(dl, dc)).Sort Key1:=.Cells(3, 1), Order1:=xlAscending, Header:=xlGuess
 
            a = 2: j = 1
            While a <= dc
                i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1)))
                    For i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1))) To Application.WorksheetFunction.Match(max, .Range(.Cells(1, 1), .Cells(dl, 1)))
                        photonpas = pas * (WB.Worksheets(4).Cells(i, 2).Value)
                        photonpasref = pas * (WB.Worksheets(4).Cells(i, 2).Value) * (WB.Worksheets(3).Cells(i, a).Value)
                        If i = Application.WorksheetFunction.Match(min, .Range(.Cells(1, 1), .Cells(dl, 1))) Then
                            somme1 = photonpas
                            somme2 = photonpasref
                        Else
                            somme1 = somme1 + photonpas
                            somme2 = somme2 + photonpasref
                        End If
                    Next i
 
                WB.Worksheets(2).Cells(j, 3).Value = (somme2 / somme1) / 100
                j = j + 1: a = a + 2
            Wend
 
            .Cells.NumberFormat = "0.00"
            .Cells.EntireColumn.AutoFit
        End With
 
        Worksheets(2).Activate
        With Worksheets(2)
            j = 1
 
            For j = 1 To .Range("A1000").End(xlUp).Row
                Worksheets(2).Range("D" & j).Activate
                Set Obj = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False)
                With Obj
                    .Width = 10
                    .Object.Caption = ""
                End With
            Next j
 
            .Rows("1:1").Insert
            .Range("A1:C1") = Array("Fichier", "Emplacement", "Reff (" & min & " - " & max & " nm) [%]")
            .Range("C1").Characters(2, 3).Font.Subscript = True
 
            .Columns(3).NumberFormat = "0.0%"
            .Cells.EntireColumn.AutoFit
            .Rows(1).Font.Bold = True
            .Select
        End With
 
        chemin_enregistrement = Application.GetSaveAsFilename("Reflectivity resume " & runnumber, ", *.xls")
        WB.SaveAs (chemin_enregistrement)
    End With
End Sub

**mercatog** · 02/08/2010, 11h17

Code :

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

With .Worksheets(3)

et

Code :

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

1
2
With Treatedfile
                With .Worksheets(1)

**johannj** · 02/08/2010, 12h13

Merci mercatog,

encore une fois, j'avais oublié ces .... des petits points!!!

Merci de ton aide, et promis, je ferai attention aux petits points par la suite!!

Johann

Dimentionner une CheckBox par code

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager