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
| Private Sub Worksheet_Activate()
If Dir("C:\Images MAUAP\Milieu piétonier\Équipement contrôle", vbDirectory) <> "Équipement contrôle" Then
MkDir ("C:\Images MAUAP\Milieu piétonier\Équipement contrôle")
End If
End Sub
Private Sub CommandButton3_Click()
Call Feuil2.Activate
End Sub
Private Sub CommandButton2_Click()
Call Feuil3.Activate
End Sub
Private Sub CommandButton7_Click()
Range("E14:E72").ClearContents
End Sub
Private Sub CommandButton8_Click()
Range("I14:I72").ClearContents
End Sub
Private Sub CommandButton1_Click()
Call Feuil6.Activate
End Sub
Private Sub CommandButton11_Click()
Call Feuil9.Activate
End Sub
Private Sub CommandButton4_Click()
Dim NomPicture As String
Dim Picture1 As Variant
On Error GoTo ErrMsg
ChDrive "C"
ChDir "C:\Images MAUAP\Milieu piétonier\Équipement contrôle"
Picture1 = Application.GetSaveAsFilename( _
FileFilter:="Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP", _
Title:="Sélectionnez une image à sauvegarder")
NomPicture = Right(Picture1, Len(Picture1) - InStrRev(Picture1, "\")) 'trouve le nom du fichier
FileCopy Picture1, "C:\Images MAUAP\Milieu piétonier\Équipement contrôle\" & NomPicture 'Copie du fichier dans l'autre emplacement
Exit Sub
ErrMsg:
MsgBox ("Vous n'avez pas sauvegardé d'image"), , "Error"
End Sub
Private Sub CommandButton5_Click()
Dim Picture1 As Variant
Dim pic As Object
Dim rng As Range
Dim rng2 As Range
Dim MyPath As String
Application.ScreenUpdating = False
Set rng = Range("B18")
Set rng2 = Range("A1", rng.Offset(-1, -1))
ChDrive "C"
ChDir "C:\Images MAUAP\Milieu piétonier\Équipement contrôle"
Picture1 = Application.GetOpenFilename( _
FileFilter:="Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP", _
Title:="Sélectionnez une image")
On Error GoTo ErrMsg
With Range("A1", rng.Offset(-1, -1))
Set pic = ActiveSheet.Shapes.AddPicture(Picture1, False, True, _
.Width, .Height, 600, 600)
End With
With pic
.LockAspectRatio = msoFalse
End With
Application.ScreenUpdating = True
Exit Sub
ErrMsg:
MsgBox ("Vous n'avez pas chargé d'image"), , "Error"
End Sub
Private Sub CommandButton6_Click()
MsgBox "Les planchers/allées d’un parcours sans obstacle présentant une pente supérieure à 1 :20 doivent respecter les spécifications techniques appliquées aux rampes (GPAU 30)" & Chr(10) & "" & Chr(10) & "Toujours envisager la construction de rampe avec les escaliers (Transports Québec 2007)" & Chr(10) & "" & Chr(10) & "Favoriser les dénivellations en rampes plutôt qu’en escaliers, dans la mesure du possible en pente douce de 1:20 ou au maximum de 1:12, pour l’accessibilité et l’entretien. Opter pour les pentes les plus douces possibles pour réduire l’effort à fournir pour les franchir (GPAU 72)", , "Informations générales"
End Sub
Private Sub CommandButton10_Click()
MsgBox "Les critères qui sont encadrés dans une bordure foncée signifie que ce sont des éléments clés de la construction" & Chr(10) & "" & Chr(10) & "Par conséquent, pour que la structure considérée soit praticable, cet éléments doit absolument être respecté", , "Éléments clé"
End Sub
Private Sub CommandButton9_Click()
Dim j As Integer
Dim Z As Integer
For j = 1 To 7
Z = j * 4
If Me.OLEObjects("OptionButton" & Z).Object.Value = False Then
Me.OLEObjects("OptionButton" & Z).Object.Value = True
End If
Next j
End Sub
Private Sub CommandButton12_Click()
MsgBox "Ministère de l'écologie et al., 2008", , "Référence"
End Sub
Private Sub CommandButton13_Click()
MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton14_Click()
MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton15_Click()
MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton16_Click()
MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton17_Click()
MsgBox "GPAU 82", , "Référence"
End Sub |
