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 |
Dimentionner une CheckBox par code
, bien que je sélectionne la colonne B??
Répondre avec citation
!!
. 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 
. 
, pour perdre du temps 
Partager