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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
| Private Sub rechercher_Click()
Dim var As String
Dim societes As Worksheet
Dim search As Range
Dim ligne As Long
Dim message As String
Dim Data As Worksheet
Dim PlageReponse As Range, zone As Range
Dim X As Integer
Dim MaPlage As Variant
Dim L As String
Dim TxtB As Control
Dim TxtB2 As Control
Dim TxtB3 As Control
Dim Aff As Control
Dim i As Integer
Dim Cl As Classe1
var = UCase(Trim(recherche.Value))
If var = "" Then
MsgBox "Veuillez indiquer Le nom du client !", vbInformation, "Attention"
End If
If var <> "" Then
With ThisWorkbook.Worksheets("societes")
Set MaPlage = .Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
End With
X = Application.WorksheetFunction.CountIf(MaPlage, var)
If X = 1 Then
Set search = Worksheets("societes").Columns(4).Find(var)
If Not search Is Nothing Then
ligne = search.Row
Set societes = ThisWorkbook.Worksheets("societes")
creation = societes.Cells(ligne, 1)
modification = societes.Cells(ligne, 2)
naturejuridique = societes.Cells(ligne, 3)
raisonsociale = societes.Cells(ligne, 4)
anciennement = societes.Cells(ligne, 5)
numero = societes.Cells(ligne, 6)
voie = societes.Cells(ligne, 7)
adresse = societes.Cells(ligne, 8)
complement = societes.Cells(ligne, 9)
BP = societes.Cells(ligne, 10)
CP = societes.Cells(ligne, 11)
ville = societes.Cells(ligne, 12)
telephone = societes.Cells(ligne, 13)
siret = societes.Cells(ligne, 14)
representants = societes.Cells(ligne, 16)
qualite = societes.Cells(ligne, 17)
infos = societes.Cells(ligne, 18)
recupnumligne = ligne
End If
End If
If X > 1 Then
With ThisWorkbook.Worksheets("societes")
Set MaPlage = .Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
End With
Set PlageReponse = PlageValeur(var, MaPlage)
If Not PlageReponse Is Nothing Then
For Each zone In PlageReponse.Areas
message = message & var & " Ligne : " & zone.Row & vbNewLine
Set Data = ThisWorkbook.Worksheets("data") 'insertion des numeros de lignes des doublons dans une autre feuille
L = L & zone.Row & vbNewLine
Data.Cells(2, 1).Value = L
Next
End If
MsgBox "Ce nom est associé à plusieurs sociétés, veuillez sélectionner celle qui vous intéresse !" _
& vbNewLine & message, vbInformation, "Information"
If vbOK Then
Set Collect = New Collection
For i = 1 To X 'boucle pour créer les TextBox / au nombre de societes trouvees
Set TxtB = Me.Controls.Add("forms.TextBox.1", "TxtB" & i, True)
Set TxtB2 = Me.Controls.Add("forms.TextBox.1", "TxtB2" & i, True)
Set TxtB3 = Me.Controls.Add("forms.TextBox.1", "TxtB3" & i, True)
Set Aff = Me.Controls.Add("forms.CommandButton.1", "Aff", True)
With TxtB
.Left = 320
.Top = 336 + ((i - 1) * 30)
.Width = 75
.Height = 15.75
.BackColor = &HFFFFFF
.BackStyle = fmBackStyleOpaque
.BorderColor = &H80000006
.BorderStyle = fmBorderStyleSingle
.ForeColor = &H80000008
.SpecialEffect = fmSpecialEffectFlat
TxtB = var
End With
With TxtB2
.Left = 408
.Top = 336 + ((i - 1) * 30)
.Width = 75
.Height = 15.75
.BackColor = &HFFFFFF
.BackStyle = fmBackStyleOpaque
.BorderColor = &H80000006
.BorderStyle = fmBorderStyleSingle
.ForeColor = &H80000008
.SpecialEffect = fmSpecialEffectFlat
End With
With TxtB3
.Left = 497
.Top = 336 + ((i - 1) * 30)
.Width = 20
.Height = 15.75
End With
With Aff
.Left = 520
.Top = 336 + ((i - 1) * 30)
.Width = 20
.Height = 18
.Name = "Aff" & i
.Caption = "OK"
End With
'ajout de l'objet dans la classe
Set Cl = New Classe1
Set Cl.TxtB = TxtB
Set Cl.TxtB2 = TxtB2
Set Cl.TxtB3 = TxtB3
Set Cl.CmBn = Aff
Collect.Add Cl
Next i
End If
End If
If X = 0 Then
MsgBox ("Le client n'existe pas ou celui-ci est mal orthographié"), vbInformation, "Attention"
End If
Exit Sub
End If
End Sub |