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
|
Sub RangementInformations()
' ********************************************** INITIALISATION des VARIABLES **********************************************
f = 1
base_donnees_2 = "2 - Composition des parois"
base_donnees_2bis = "2bis - Autres informations"
suivi_chantier = "3 - Suivi de chantier"
' ********************************************** PROGRAMME PRINCIPAL **********************************************
With Sheets(base_donnees_2)
For Each Cell In .Range(.Cells(7, 2), .Cells(7, 2).End(xlDown)).Cells
' ---------------------------------------- COMBLES AMENAGES ----------------------------------------
If Cell.Value = "Combles aménagés" Then
MsgBox "Combles aménagés dans cellule : " & Cell.Address
End If
' ---------------------------------------- COMBLES PERDUS ----------------------------------------
If Cell.Value = "Combles perdus" Then
MsgBox "Combles perdus dans cellule : " & Cell.Address
End If
' ---------------------------------------- MUR DE FACADE ----------------------------------------
If Cell.Value = "Mur de façade" Then
MsgBox "Mur de façade " & Cell.Offset(0, 1).Value & " dans cellule : " & Cell.Address
Sheets(suivi_chantier).Select
If f <> 1 Then
Rows(3 + f * 7).Insert
Rows(3 + f * 7).Insert
Rows(3 + f * 7).Insert
Rows(3 + f * 7).Insert
Rows(3 + f * 7).Insert
Rows(3 + f * 7).Insert
Rows(3 + f * 7).Insert
Range(Cells(3 + f * 7, 4), Cells(3 + f * 7, 12)).Select
Selection.Copy
Cells(3 + f * 7, 4).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
' NOM de la paroi
Cells(4 + f * 7, 4) = Cell.Offset(0, 1)
' LOCALISATION de la paroi
Cells(3 + f * 7, 6) = Cell.Offset(0, 2)
' EXIGENCE acoustique
Cells(4 + f * 7, 5).Value = Cell.Offset(0, 14).Value
' Composition et épaisseur du SUPPORT
If IsEmpty(Cell.Offset(0, 4)) Then
Cells(5 + f * 7, 5).Value = Cell.Offset(0, 3).Value
Else
Cells(5 + f * 7, 5).Value = Cell.Offset(0, 3).Value & Chr(10) & "Epaisseur = " & Cell.Offset(0, 4).Value & " cm"
End If
' Type, localisation, référence et épaisseur de l'ISOLANT
If IsEmpty(Cell.Offset(0, 8)) Then
Cells(6 + f * 7, 5).Value = "Isolation " & Cell.Offset(0, 5).Value & ", " & Cell.Offset(0, 6).Value & " " & Cell.Offset(0, 7).Value
Else
Cells(6 + f * 7, 5).Value = "Isolation " & Cell.Offset(0, 5).Value & ", " & Cell.Offset(0, 6).Value & " " & Cell.Offset(0, 7).Value & Chr(10) & " Epaisseur = " & Cell.Offset(0, 8).Value & " cm"
End If
With Sheets(base_donnees_2bis)
For Each Cell2 In .Range(.Cells(6, 2), .Cells(6, 2).End(xlDown)).Cells
If Cell2.Value = "MF1" Then
Sheets(suivi_chantier).Select
' Référence et exigence de la MENUISERIE
If Cell2.Offset(0, 1).Value = "Fenêtre" Then
Cells(7 + f * 7, 5).Value = Cell2.Offset(0, 2).Value & Chr(10) & " Rw+Ctr = " & Cell2.Offset(0, 3).Value & " dB"
End If
' Référence et exigence de l'ENTREE D'AIR
If Cell2.Offset(0, 1).Value = "Entrée d'air" Then
Cells(8 + f * 7, 5).Value = Cell2.Offset(0, 2).Value & Chr(10) & " Dn,e,w+Ctr = " & Cell2.Offset(0, 4).Value & " dB"
End If
' Référence et exigence du COFFRE DE VOLET ROULANT
If Cell2.Offset(0, 1).Value = "Coffre de volet roulant" Then
Cells(9 + f * 7, 5).Value = Cell2.Offset(0, 2).Value & Chr(10) & " Dn,e,w+Ctr = " & Cell2.Offset(0, 4).Value & " dB"
End If
End If
Next Cell2
End With
f = f + 1
End If
' ---------------------------------------- AUTRE ----------------------------------------
If Cell.Value = "Autre" Then
MsgBox "Autre type de paroi dans cellule : " & Cell.Address
End If
Next Cell
End With
End Sub |
