Dimentionner une CheckBox par code

Version imprimable

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:

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:

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 8O, 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?

Je reviens vers vous encore une fois :oops:!!
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:

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

Code:

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

16/07/2010, 17h08
johannj

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 :aie::oops:!!
Johann
16/07/2010, 17h18
mercatog

mets ceci

Code:

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

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:

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!!

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:

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:

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:

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

Bonjour le forum, bonjour le fil,

Merci mercatog pour tes réponses, et désolé de répondre aussi tard:aie:

Merci pour les informations sur les indentations et les sélections de range.

Pour la déclaration des variables, on m'a donné le même conseil depuis le début et j'avoue que j'essaie de m'y tenir. Donc, je mets toujours l'option Explicit en début de code, même si je ne le mets pas sur les post du forum, désolé.
Justement, en parlant de déclaration de variables, je viens de me rendre compte que mon erreur type 13, incompatibilité de type vient de ma déclaration de variable. Je déclarais Obj comme un OLEObjects (le code complet de la macro est en dessous). J'avais remarqué que la macro me mettait toujours le premier checkbox, et après l'erreur type 13 apparaissait. J'ai donc fait un essai en enlevant l'option Explicit, et en ne déclarant pas Obj. Et là, çà fonctionne comme je veux :ccool:. Le problème du coup, c'est que je ne déclare pas toutes mes variables, et que je ne suis pas les conseils maintes fois répétés par le forum :cry:.

J'ai alors fait un autre essai, en elevant le "s" lors de ma déclaration de Obj, et çà fonctionne à merveille, même avac l'option explicit :ccool:!!

Il suffit parfois de pas grand chose :lol:, pour perdre du temps :oops:

Merci à tous pour votre aide,

Cordialement,
Johann

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
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
Option Explicit
 
Sub reflectivité()
    Dim WB As Workbook, Treatedfile As Workbook
    Dim Openreference As Variant
    Dim a As Integer, dl As Long, dc As Integer, i As Integer, numecelvide As Integer, j As Integer, pas As Double
    Dim min As Integer, max As Integer, dll As Integer
    Dim emplacement As String, chemin_enregistrement As String, fichier_traite As String, fichier As String
    Dim tableau() As String, somme As String
    Dim photonpas As Single, somme1 As Single, photonpasref As Single, somme2 As Single, refeff  As Single
    Dim t As Variant, l As Variant
    Dim Obj As OLEObjects
 
    Application.ScreenUpdating = False
 
    Set WB = ThisWorkbook
    WB.Worksheets(4).Visible = False
 
    Openreference = Application.GetOpenFilename("", , "Reflectivity File Selection", , True)
    If Openreference = False Then Exit Sub
 
    a = 1
    j = 1
    For a = 1 To UBound(Openreference)
        Set Treatedfile = Application.Workbooks.Open(Openreference(a)) '(OpenFile, xlMSDOS)
            fichier = Treatedfile.Name
            tableau = Split(fichier, ".")
            fichier_traite = tableau(0)
            emplacement = Treatedfile.Path
 
            WB.Worksheets(2).Cells(a, 1).Value = fichier
            WB.Worksheets(2).Cells(a, 2).Value = emplacement
 
            With Treatedfile
                With Worksheets(1)
                    dl = .Range("A1000").End(xlUp).Row 'cherche le nombre de ligne , le point devant le range dit que l'on se trouve dans l'objet plus grand du with
                    dc = .Range("Z" & dl).End(xlToLeft).Column 'cherche le nombre de colonne
                    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_traite
                        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_traite
                        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
 
        With Worksheets(2)
            j = 1
 
            For j = 1 To dl
                .Range("D" & j).Select
                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
 
    End With
End Sub

02/08/2010, 09h43
johannj

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é :aie:.
Je me place pourtant dans la feuille de calcul 2.

Je ne comprends pas pourquoi çà plante :calim2:

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

Cordialement,
Johann

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:

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 :calim2:!!

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

Merci d'avance,
Johann

02/08/2010, 10h29
mercatog

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

Bonjour Mercatog,

Merci de ta réponse.

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

Mon code est déjà dans un module. :oops:

Mon code entier, dans le module est le suivant:

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
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

Code:

With .Worksheets(3)

Code:

1
2
With Treatedfile
                With .Worksheets(1)

02/08/2010, 12h13
johannj

Merci mercatog,

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

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

Johann
02/08/2010, 12h18
johannj

mercatog,

même avec les points, çà plante!!!

Bon, et bien je crois que je vais choisir la méthode activate pour les moment.

Merci de ton aide,

Johann