Private Cel As Range
Private L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
Private P1 As Range, P2 As Range, P3 As Range, P4 As Range
Private L11 As Integer, L22 As Integer, L33 As Integer, L44 As Integer
Private P11 As Range, P22 As Range, P33 As Range, P44 As Range
Private L111 As Integer, L222 As Integer, L333 As Integer, L444 As Integer, L555 As Integer
Private P111 As Range, P222 As Range, P333 As Range, P444 As Range, P555 As Range
Private x As Integer
Private Sub UserForm_Initialize()
''PARTIE BUREAU DE CONTROLE
L1 = shtDonnees.Range('B500').End(xlUp).Row
L2 = shtDonnees.Range('C500').End(xlUp).Row
L3 = shtDonnees.Range('D500').End(xlUp).Row
L4 = shtDonnees.Range('E500').End(xlUp).Row
Set P1 = shtDonnees.Range('B7:B' & L1)
Set P2 = shtDonnees.Range('C7:C' & L2)
Set P3 = shtDonnees.Range('D7:D' & L3)
Set P4 = shtDonnees.Range('E7:E' & L4)
frmBuroExt.regNomCont.Clear
frmBuroExt.regAdresseCont.Clear
frmBuroExt.regCPCont.Clear
frmBuroExt.regTelCont.Clear
''remplit les trois ComboBoxes sans boublons par la methode AddItem
'Pour le Bureau de control
'boucle 1 : sur toutes les cellules Cel de la plage B7:B_fin
For Each Cel In P1
If frmBuroExt.regNomCont.ListCount > 0 Then
For x = 0 To frmBuroExt.regNomCont.ListCount - 1
If Cel.Value = frmBuroExt.regNomCont.List(x) Then
GoTo 1
End If
Next x
End If
frmBuroExt.regNomCont.AddItem Cel.Value
1
Next Cel
For Each Cel In P2
If frmBuroExt.regAdresseCont.ListCount > 0 Then
For x = 0 To frmBuroExt.regAdresseCont.ListCount - 1
If Cel.Value = frmBuroExt.regAdresseCont.List(x) Then
GoTo 2
End If
Next x
End If
frmBuroExt.regAdresseCont.AddItem Cel.Value
2
Next Cel
For Each Cel In P3
If frmBuroExt.regCPCont.ListCount > 0 Then
For x = 0 To frmBuroExt.regCPCont.ListCount - 1
If Cel.Value = frmBuroExt.regCPCont.List(x) Then
GoTo 3
End If
Next x
End If
frmBuroExt.regCPCont.AddItem Cel.Value
3
Next Cel
For Each Cel In P4
If frmBuroExt.regTelCont.ListCount > 0 Then
For x = 0 To frmBuroExt.regTelCont.ListCount - 1
If Cel.Value = frmBuroExt.regTelCont.List(x) Then
GoTo 4
End If
Next x
End If
frmBuroExt.regTelCont.AddItem Cel.Value
4
Next Cel
frmBuroExt.regAdresseCont.Enabled = False
frmBuroExt.regCPCont.Enabled = False
frmBuroExt.regTelCont.Enabled = False
''PARTIE DU CONTROLE SPS
L11 = shtDonnees.Range('G500').End(xlUp).Row
L22 = shtDonnees.Range('H500').End(xlUp).Row
L33 = shtDonnees.Range('I500').End(xlUp).Row
L44 = shtDonnees.Range('J500').End(xlUp).Row
Set P11 = shtDonnees.Range('G7:G' & L11)
Set P22 = shtDonnees.Range('H7:H' & L22)
Set P33 = shtDonnees.Range('I7:I' & L33)
Set P44 = shtDonnees.Range('J7:J' & L44)
frmBuroExt.regNomSps.Clear
frmBuroExt.regAdresseSps.Clear
frmBuroExt.regCPSps.Clear
frmBuroExt.regTelSps.Clear
''remplit les trois ComboBoxes sans boublons par la methode AddItem
'Pour le Bureau de control
'boucle 1 : sur toutes les cellules Cel de la plage B7:B_fin
For Each Cel In P11
If frmBuroExt.regNomSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regNomSps.ListCount - 1
If Cel.Value = frmBuroExt.regNomSps.List(x) Then
GoTo 5
End If
Next x
End If
frmBuroExt.regNomSps.AddItem Cel.Value
5
Next Cel
For Each Cel In P22
If frmBuroExt.regAdresseSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regAdresseSps.ListCount - 1
If Cel.Value = frmBuroExt.regAdresseSps.List(x) Then
GoTo 6
End If
Next x
End If
frmBuroExt.regAdresseSps.AddItem Cel.Value
6
Next Cel
For Each Cel In P33
If frmBuroExt.regCPSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regCPSps.ListCount - 1
If Cel.Value = frmBuroExt.regCPSps.List(x) Then
GoTo 7
End If
Next x
End If
frmBuroExt.regCPSps.AddItem Cel.Value
7
Next Cel
For Each Cel In P44
If frmBuroExt.regTelSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regTelSps.ListCount - 1
If Cel.Value = frmBuroExt.regTelSps.List(x) Then
GoTo 8
End If
Next x
End If
frmBuroExt.regTelSps.AddItem Cel.Value
8
Next Cel
frmBuroExt.regAdresseSps.Enabled = False
frmBuroExt.regCPSps.Enabled = False
frmBuroExt.regTelSps.Enabled = False
''PARTIE DU BUREAU D'ETUDE
L111 = shtDonnees.Range('M500').End(xlUp).Row
L222 = shtDonnees.Range('N500').End(xlUp).Row
L333 = shtDonnees.Range('O500').End(xlUp).Row
L444 = shtDonnees.Range('P500').End(xlUp).Row
L555 = shtDonnees.Range('L500').End(xlUp).Row
Set P111 = shtDonnees.Range('M7:M' & L111)
Set P222 = shtDonnees.Range('N7:N' & L222)
Set P333 = shtDonnees.Range('O7:O' & L333)
Set P444 = shtDonnees.Range('P7:P' & L444)
Set P555 = shtDonnees.Range('L7:L' & L555)
frmBuroExt.regNomEtude.Clear
frmBuroExt.regAdresseEtude.Clear
frmBuroExt.regCPEtude.Clear
frmBuroExt.regTelEtude.Clear
frmBuroExt.regTypeBuroExt.Clear
''remplit les trois ComboBoxes sans boublons par la methode AddItem
'Pour le Bureau de control
'boucle 1 : sur toutes les cellules Cel de la plage B7:B_fin
For Each Cel In P111
If frmBuroExt.regNomEtude.ListCount > 0 Then
For x = 0 To frmBuroExt.regNomEtude.ListCount - 1
If Cel.Value = frmBuroExt.regNomEtude.List(x) Then
GoTo 9
End If
Next x
End If
frmBuroExt.regNomEtude.AddItem Cel.Value
9
Next Cel
For Each Cel In P222
If frmBuroExt.regAdresseEtude.ListCount > 0 Then
For x = 0 To frmBuroExt.regAdresseEtude.ListCount - 1
If Cel.Value = frmBuroExt.regAdresseEtude.List(x) Then
GoTo 10
End If
Next x
End If
frmBuroExt.regAdresseEtude.AddItem Cel.Value
10
Next Cel
For Each Cel In P333
If frmBuroExt.regCPSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regCPEtude.ListCount - 1
If Cel.Value = frmBuroExt.regCPEtude.List(x) Then
GoTo 11
End If
Next x
End If
frmBuroExt.regCPEtude.AddItem Cel.Value
11
Next Cel
For Each Cel In P444
If frmBuroExt.regTelEtude.ListCount > 0 Then
For x = 0 To frmBuroExt.regTelEtude.ListCount - 1
If Cel.Value = frmBuroExt.regTelEtude.List(x) Then
GoTo 12
End If
Next x
End If
frmBuroExt.regTelEtude.AddItem Cel.Value
12
Next Cel
For Each Cel In P555
If frmBuroExt.regTypeBuroExt.ListCount > 0 Then
For x = 0 To frmBuroExt.regTypeBuroExt.ListCount - 1
If Cel.Value = frmBuroExt.regTypeBuroExt.List(x) Then
GoTo 13
End If
Next x
End If
frmBuroExt.regTypeBuroExt.AddItem Cel.Value
13
Next Cel
frmBuroExt.regNomEtude.Enabled = False
frmBuroExt.regAdresseEtude.Enabled = False
frmBuroExt.regCPEtude.Enabled = False
frmBuroExt.regTelEtude.Enabled = False
End Sub
Public Sub btnSuivantBuroExt_Click()
shtPanneau.Activate
'' mise en page et entrée des bureaux de controles
shtPanneau.Range(Cells(35, 2), Cells(35, 4)).Select
With Selection.Font
.Name = 'Tahoma'
.Size = 12
.Bold = True
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
shtPanneau.Range('A35').Select
With Selection.Font
.Name = 'Tahoma'
.Size = 12
.Bold = True
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.IndentLevel = 2
End With
shtPanneau.Range(Cells(36, 2), Cells(38, 4)).Select
With Selection.Font
.Name = 'Tahoma'
.Size = 10
.Bold = False
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
shtPanneau.Range('B35').Value _
= frmBuroExt.regNomCont.Value
shtPanneau.Range('B36').Value _
= frmBuroExt.regAdresseCont.Value
shtPanneau.Range('B37').Value _
= frmBuroExt.regCPCont.Value
shtPanneau.Range('B38').Value _
= frmBuroExt.regTelCont.Value
'' mise en page et entrée des coordinateurs sps
shtPanneau.Select
shtPanneau.Range(Cells(43, 2), Cells(43, 4)).Select
With Selection.Font
.Name = 'Tahoma'
.Size = 12
.Bold = True
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
shtPanneau.Range(Cells(44, 2), Cells(46, 4)).Select
With Selection.Font
.Name = 'Tahoma'
.Size = 10
.Bold = False
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
shtPanneau.Range('B43').Value _
= frmBuroExt.regNomSps.Value
shtPanneau.Range('B44').Value _
= frmBuroExt.regAdresseSps.Value
shtPanneau.Range('B45').Value _
= frmBuroExt.regCPSps.Value
shtPanneau.Range('B46').Value _
= frmBuroExt.regTelSps.Value
'' mise en page et entrée des bureaux d'études
shtPanneau.Select
shtPanneau.Range(Cells(51, 1), Cells(51, 4)).Select
With Selection.Font
.Name = 'Tahoma'
.Size = 12
.Bold = True
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
shtPanneau.Range('A51').Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.IndentLevel = 2
End With
shtPanneau.Range(Cells(52, 2), Cells(55, 4)).Select
With Selection.Font
.Name = 'Tahoma'
.Size = 10
.Bold = False
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
shtPanneau.Range('A51').Value _
= frmBuroExt.regTypeBuroExt.Value
shtPanneau.Range('B52').Value _
= frmBuroExt.regNomEtude.Value
shtPanneau.Range('B53').Value _
= frmBuroExt.regAdresseEtude.Value
shtPanneau.Range('B54').Value _
= frmBuroExt.regCPEtude.Value
shtPanneau.Range('B55').Value _
= frmBuroExt.regTelEtude.Value
frmBuroExt.Hide
frmInfos.Show
End Sub
Public Sub btnCancelBuroExt_Click()
shtPlanning.Select
shtPlanning.Range('A1').Select
shtCR.Select
shtCR.Range('A1').Select
shtPanneau.Select
shtPanneau.Range('A1').Select
shtAcceuil.Select
frmBuroExt.Hide
End Sub
Public Sub regNomCont_Change()
frmBuroExt.regAdresseCont.Clear
frmBuroExt.regCPCont.Clear
frmBuroExt.regTelCont.Clear
frmBuroExt.regAdresseCont.Enabled = True
frmBuroExt.regCPCont.Enabled = True
frmBuroExt.regTelCont.Enabled = True
'
For Each Cel In P1 '
If Cel.Value = frmBuroExt.regNomCont.Value Then
If frmBuroExt.regAdresseCont.ListCount > 0 Then '
For x = 0 To frmBuroExt.regAdresseCont.ListCount - 1
If Cel.Offset(0, 1).Value = frmBuroExt.regAdresseCont.List(x) Then
GoTo 14
End If
Next x
End If
frmBuroExt.regAdresseCont.AddItem Cel.Offset(0, 1).Value
14
If frmBuroExt.regCPCont.ListCount > 0 Then
For x = 0 To frmBuroExt.regCPCont.ListCount - 1
If CStr(Cel.Offset(0, 2).Value) = CStr(frmBuroExt.regCPCont.List(x)) Then
GoTo 15
End If
Next x
End If
frmBuroExt.regCPCont.AddItem Cel.Offset(0, 2).Value
15
If frmBuroExt.regTelCont.ListCount > 0 Then
For x = 0 To frmBuroExt.regTelCont.ListCount - 1
If CStr(Cel.Offset(0, 3).Value) = CStr(frmBuroExt.regTelCont.List(x)) Then
GoTo 16
End If
Next x
End If
frmBuroExt.regTelCont.AddItem Cel.Offset(0, 3).Value
End If
16
Next Cel
End Sub
Public Sub regNomSps_Change()
frmBuroExt.regAdresseSps.Clear
frmBuroExt.regCPSps.Clear
frmBuroExt.regTelSps.Clear
frmBuroExt.regAdresseSps.Enabled = True
frmBuroExt.regCPSps.Enabled = True
frmBuroExt.regTelSps.Enabled = True
For Each Cel In P11
If Cel.Value = frmBuroExt.regNomSps.Value Then
If frmBuroExt.regAdresseSps.ListCount > 0 Then '
For x = 0 To frmBuroExt.regAdresseSps.ListCount - 1
If Cel.Offset(0, 1).Value = frmBuroExt.regAdresseSps.List(x) Then
GoTo 17
End If
Next x
End If
frmBuroExt.regAdresseSps.AddItem Cel.Offset(0, 1).Value
17
If frmBuroExt.regCPSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regCPSps.ListCount - 1
If CStr(Cel.Offset(0, 2).Value) = CStr(frmBuroExt.regCPSps.List(x)) Then
GoTo 18
End If
Next x
End If
frmBuroExt.regCPSps.AddItem Cel.Offset(0, 2).Value
18
If frmBuroExt.regTelSps.ListCount > 0 Then
For x = 0 To frmBuroExt.regTelSps.ListCount - 1
If CStr(Cel.Offset(0, 3).Value) = CStr(frmBuroExt.regTelSps.List(x)) Then
GoTo 19
End If
Next x
End If
frmBuroExt.regTelSps.AddItem Cel.Offset(0, 3).Value
End If
19
Next Cel
End Sub
Public Sub regTypeBuroExt_Change()
frmBuroExt.regNomEtude.Clear
frmBuroExt.regAdresseEtude.Clear
frmBuroExt.regCPEtude.Clear
frmBuroExt.regTelEtude.Clear
frmBuroExt.regNomEtude.Enabled = True
frmBuroExt.regAdresseEtude.Enabled = True
frmBuroExt.regCPEtude.Enabled = True
frmBuroExt.regTelEtude.Enabled = True
For Each Cel In P555
If Cel.Value = frmBuroExt.regTypeBuroExt.Value Then
If frmBuroExt.regNomEtude.ListCount > 0 Then '
For x = 0 To frmBuroExt.regNomEtude.ListCount - 1
If Cel.Offset(0, 1).Value = frmBuroExt.regNomEtude.List(x) Then
GoTo 20
End If
Next x
End If
frmBuroExt.regNomEtude.AddItem Cel.Offset(0, 1).Value
20
If frmBuroExt.regAdresseEtude.ListCount > 0 Then '
For x = 0 To frmBuroExt.regAdresseEtude.ListCount - 1
If Cel.Offset(0, 2).Value = frmBuroExt.regAdresseEtude.List(x) Then
GoTo 21
End If
Next x
End If
frmBuroExt.regAdresseEtude.AddItem Cel.Offset(0, 2).Value
21
If frmBuroExt.regCPEtude.ListCount > 0 Then
For x = 0 To frmBuroExt.regCPEtude.ListCount - 1
If CStr(Cel.Offset(0, 3).Value) = CStr(frmBuroExt.regCPEtude.List(x)) Then
GoTo 22
End If
Next x
End If
frmBuroExt.regCPEtude.AddItem Cel.Offset(0, 3).Value
22
If frmBuroExt.regTelEtude.ListCount > 0 Then
For x = 0 To frmBuroExt.regTelEtude.ListCount - 1
If CStr(Cel.Offset(0, 4).Value) = CStr(frmBuroExt.regTelEtude.List(x)) Then
GoTo 23
End If
Next x
End If
frmBuroExt.regTelEtude.AddItem Cel.Offset(0, 4).Value
End If
23
Next Cel
End Sub