Collage avec liaisons

  • Initiateur de la discussion Quaisako
  • Date de début
Q

Quaisako

Guest
Bonjour le forum,

J'ai 2 classeurs : 'Saisie' et 'Banque'

Dans le classeur 'Saisie', à l'aide d'une USF, je renseigne:
Col A => Section
Col B => Nom
Col C => Prenom
Col D => Adresse
Col E => CP
..................................etc
Dans ce même classeur, lorsque je supprime un nom à l'aide de la USF, toute la ligne concernant ce nom, disparait.
_____________________________________
Dans le classeur 'Banque', je récupère les Noms et les Prenoms des colonnes B et C du classeur 'Saisie' avec un collage avec liaisons.
Col A => Nom
Col B => Prenom
Col C => Banque
Col D => N° de chèque
Col E => Montant
....................................etc
Les colonnes A et B sont donc renseignées à l'ouverture du classeur.
Je renseigne les colonnes C, D, E et les autres, manuellement.
Jusque là, no problem.
________________________________________
Là où ça se complique, c'est quand je fais un ajout ou une suppression dans le classeur 'Saisie'.

Dans l'un ou l'autre cas, à l'ouverture du classeur 'Banque', j'accepte la mise à jour, pour que les Noms et Prénoms des 2 classeurs soient identiques.

Le problème est que dans le classeur 'Banque' les colonnes C, D, E et les suivantes n'ont pas suivi. Il y a un décalge par rapport aux colonnes A et B.

Je joints les 2 classeurs. Ce sera plus parlant pour les Excelliens qui voudrons bien se pencher sur mon problème.

Jevous remercie d'avance pour votre aide.
Jipé
[file name=Essai_liaisons.zip size=14242]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Essai_liaisons.zip[/file]
 

Pièces jointes

  • Essai_liaisons.zip
    13.9 KB · Affichages: 13
Trier par date Trier par votes
Dan

Dan

XLDnaute Barbatruc
Bonjour,

Après lecture de ton message et avoir regardé ton fichier, je vois que tu parles de USF mais je ne vois pas de macros dans tes fichiers.

Donc là difficile de répondre sans voir le code de la macro et savoir dans quel fichier il se trouve.

Peux-t-on voir ce code ?

:)
 
Vote positif 0 Vote négatif
Q

Quaisako

Guest
Re à tous,

Merci @+Dan, pour ta réponse.

Je ne pensais pas que le code du classeur 'Saisie' était indispensable.

Ce code n'est pas un secret. Il a été réalisé presque en entier par @+Thierry il y a deux ans. Mais, zipé, ce classeur pèse 240 Ko. Donc problème pour le poster ici.

Voici à quoi il ressemble.


Option Explicit

Dim NomLBindex As Integer
Dim LRecherche As Integer

Private Sub CommandButton12_Click()
Unload USF_Saisie_Adhérents
End Sub

Private Sub LblFonction_Click()

End Sub

Private Sub userform_Initialize() ' MODE STANDARD A l'INITIALISATION
Dim L As Integer
Dim Plage As String
SortNom
With TxtSection
.Value = 'BASKET'
.Enabled = False
End With
With TxtNom
.Value = ''
.Enabled = False
End With
With TxtPrénom
.Value = ''
.Enabled = False
End With
With CbxSexe
.Value = ''
.Enabled = False
End With
With TxtAdresse
.Value = ''
.Enabled = False
End With
With TxtCodePostal
.Value = ''
.Enabled = False
End With
With CbxVilles
.Value = ''
.Enabled = False
End With
With TxtTéléphone
.Value = ''
.Enabled = False
End With
With TxtTélPortable
.Value = ''
.Enabled = False
End With
With TxtEmail
.Value = ''
.Enabled = False
End With
With TxtDateDeNais
.Value = ''
.Enabled = False
End With
With TxtN°deLicence
.Value = ''
.Enabled = False
End With
With CbxAss
.Value = ''
.Enabled = False
End With
With TxtMutation
.Value = ''
.Enabled = False
End With
With CbxCatégories1
.Value = ''
.Enabled = False
End With
With CbxCatégories2
.Value = ''
.Enabled = False
End With
With CbxCatégories3
.Value = ''
.Enabled = False
End With
With CbxPaiements
.Value = ''
.Enabled = False
End With
With CbxAutreSection
.Value = ''
.Enabled = False
End With


L = Sheets('Detail').Range('A65536').End(xlUp).Row
Plage = Sheets('Detail').Range('B6:S' & L).Address
ListBox1.RowSource = 'Detail!' & Plage
CommandButton3.Visible = False
CommandButton4.Visible = False
CommandButton5.Visible = False
CommandButton8.Visible = False
CommandButton9.Visible = False
CommandButton10.Visible = False
CommandButton11.Visible = False
ListBox2.Visible = False
Frame1.Visible = False
USF_Saisie_Adhérents.Caption = 'SMD Section Basket => Mode Standard'
LblNbLicenciés.Caption = ListBox1.ListCount 'Ici, on compte le nombre de licenciés.

End Sub

Private Sub ListBox1_Click() ' <<<<<<<<<<<<<<<<<<<<<<<<FENETRE D'OUVERTURE
NomLBindex = ListBox1.ListIndex + 6
TxtSection = Sheets('Detail').Range('A' & NomLBindex)
TxtNom = Sheets('Detail').Range('B' & NomLBindex)
TxtPrénom = Sheets('Detail').Range('C' & NomLBindex)
CbxSexe = Sheets('Detail').Range('D' & NomLBindex)
TxtAdresse = Sheets('Detail').Range('E' & NomLBindex)
TxtCodePostal = Format(Sheets('Detail').Range('F' & NomLBindex), '00000')
CbxVilles = Sheets('Detail').Range('G' & NomLBindex)
TxtTéléphone = Format(Sheets('Detail').Range('H' & NomLBindex), '00 00 00 00 00')
TxtTélPortable = Format(Sheets('Detail').Range('I' & NomLBindex), '00 00 00 00 00')
TxtEmail = Format(Sheets('Detail').Range('J' & NomLBindex), '00 00 00 00 00')
TxtDateDeNais = Format(Sheets('Detail').Range('K' & NomLBindex), 'd-mmm-yy')
TxtN°deLicence = Format(Sheets('Detail').Range('L' & NomLBindex), '#\\ ##\\ ####')
CbxAss = Sheets('Detail').Range('M' & NomLBindex)
TxtMutation = Sheets('Detail').Range('N' & NomLBindex)
CbxCatégories1 = Sheets('Detail').Range('O' & NomLBindex)
CbxCatégories2 = Sheets('Detail').Range('P' & NomLBindex)
CbxCatégories3 = Sheets('Detail').Range('Q' & NomLBindex)
CbxPaiements = Sheets('Detail').Range('R' & NomLBindex)
CbxAutreSection = Sheets('Detail').Range('S' & NomLBindex)
CommandButton3.Visible = True
If TxtPrénom <> '' Then
End If
End Sub

'====================================================================================
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<CHANGEMENT>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub CmdNouveau_Click() 'LANCEMENT MODE NOUVEAU
With TxtSection
.Value = 'BASKET'
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtNom
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtPrénom
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxSexe
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtAdresse
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtCodePostal
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxVilles
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtTéléphone
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtTélPortable
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtEmail
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtDateDeNais
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtN°deLicence
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxAss
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With TxtMutation
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxCatégories1
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxCatégories2
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxCatégories3
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxPaiements
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
With CbxAutreSection
.Value = ''
.Enabled = True
.BackColor = RGB(255, 204, 153)
End With
USF_Saisie_Adhérents.Caption = 'SMD Section Basket => MODE NOUVELLE ENTREE'
ListBox1.Visible = False
CommandButton3.Visible = False
CommandButton4.Visible = True
CommandButton6.Visible = False
Frame1.Visible = False
USF_Saisie_Adhérents.BackColor = RGB(255, 153, 0)
Frame1.BackColor = RGB(255, 153, 0)
CmdNouveau.Visible = False
With CommandButton7
.Left = 30
.Top = 84
End With
TxtSection.SetFocus
End Sub

Private Sub CommandButton4_Click() 'MODE NOUVEAU VALIDATION
Dim Msg1 As String
Dim Msg2 As String
Dim L2 As Integer
If TxtNom = '' Then
MsgBox 'Votre Contact n'a pas de nom ? ', vbCritical, 'SMD Section Basket = Mode Nouveau Validation Error'
Exit Sub
End If
If TxtPrénom = '' Then
MsgBox 'Votre adhérent doit au minimu avoir un Prénom ', vbCritical, 'SMD Section Basket = Mode Nouveau Validation Error'
Exit Sub
End If

Msg1 = MsgBox('Voulez-vous ajouter cette nouvelle entrée ? ' _
& vbCrLf & vbCrLf & vbTab & 'Nom : ' & vbTab & TxtNom _
& vbCrLf & vbCrLf & vbTab & 'Prénom : ' & vbTab & TxtPrénom _
& vbCrLf & vbCrLf & vbTab & 'Catégorie : ' & vbTab & CbxCatégories1, vbYesNo, 'SMD Section Basket => Mode Nouveau Validation')
If Msg1 = vbYes Then
ListBox1 = ''
L2 = Sheets('Detail').Range('A65536').End(xlUp).Row + 1
With Sheets('Detail')
.Range('A' & L2).Value = TxtSection.Value
.Range('B' & L2).Value = TxtNom.Value
.Range('C' & L2).Value = TxtPrénom.Value
.Range('D' & L2).Value = CbxSexe.Value
.Range('E' & L2).Value = TxtAdresse.Value
.Range('F' & L2).Value = TxtCodePostal.Value
.Range('G' & L2).Value = CbxVilles.Value
.Range('H' & L2).Value = TxtTéléphone.Value
.Range('I' & L2).Value = TxtTélPortable.Value
.Range('J' & L2).Value = TxtEmail.Value
.Range('K' & L2).Value = TxtDateDeNais.Value
.Range('L' & L2).Value = TxtN°deLicence.Value
.Range('M' & L2).Value = CbxAss.Value
.Range('N' & L2).Value = TxtMutation.Value
.Range('O' & L2).Value = CbxCatégories1.Value
.Range('P' & L2).Value = CbxCatégories2.Value
.Range('Q' & L2).Value = CbxCatégories3.Value
.Range('R' & L2).Value = CbxPaiements.Value
.Range('S' & L2).Value = CbxAutreSection.Value
End With
End If
'*************** Ici, je copie les colonnes Nom et Prénom (B, C de la feuille
'Detail) dans la feuille (Paiements colonnes A et B).
L2 = Sheets('Paiements').Range('A65536').End(xlUp).Row + 1
With Sheets('Paiements')
.Range('A' & L2).Value = TxtNom.Value
.Range('B' & L2).Value = TxtPrénom.Value
End With
'****************
Msg2 = MsgBox('Voulez-vous continuer pour d'autres nouvelles entrées ?', _
vbYesNo, 'SMD Section Basket => Mode Nouveau Continuer ?')
If Msg2 = vbYes Then

'===============================================================================CHANTIER !
' L2 = Sheets('Detail').Range('V65536').End(xlUp).Row
TxtSection = 'BASKET'
TxtNom = ''
TxtPrénom = ''
CbxSexe = ''
TxtAdresse = ''
TxtCodePostal = ''
CbxVilles = ''
TxtTéléphone = ''
TxtTélPortable = ''
TxtEmail = ''
TxtDateDeNais = ''
TxtN°deLicence = ''
CbxAss = ''
TxtMutation = ''
CbxCatégories1 = ''
CbxCatégories2 = ''
CbxCatégories3 = ''
CbxPaiements = ''
CbxAutreSection = ''
TxtSection.SetFocus
Else
Unload Me
USF_Saisie_Adhérents.Show
End If
End Sub

Private Sub TxtSection_Change()
TxtSection.Value = UCase(TxtSection.Value)
End Sub

Private Sub TxtNom_Change() 'Format Nom en majuscule
TxtNom.Value = UCase(TxtNom.Value)
End Sub

Private Sub TxtPrénom_Change() 'Format Prénom en majuscule
TxtPrénom.Value = UCase(TxtPrénom.Value)
End Sub

Private Sub CbxSexe_Change()
CbxSexe.Value = UCase(CbxSexe.Value)
End Sub

Private Sub TxtAdresse_Change()
TxtAdresse.Value = UCase(TxtAdresse.Value)
End Sub

Private Sub CbxVilles_Change()
CbxVilles.Value = UCase(CbxVilles.Value)
End Sub

Private Sub CbxCatégories1_Change()
CbxCatégories1.Value = UCase(CbxCatégories1.Value)
End Sub

Private Sub CbxCatégories2_Change()
CbxCatégories2.Value = UCase(CbxCatégories2.Value)
End Sub

Private Sub CbxCatégories3_Change()
CbxCatégories3.Value = UCase(CbxCatégories3.Value)
End Sub

Private Sub TxtMutation_Change()
TxtMutation.Value = UCase(TxtMutation.Value)
End Sub

Private Sub CbxPaiements_Change()
CbxPaiements.Value = UCase(CbxPaiements.Value)
End Sub

Private Sub CbxAutreSection_Change()
CbxAutreSection.Value = UCase(CbxAutreSection.Value)
End Sub

Private Sub TxtTéléphone_Change() 'Format Telephone (Grace à Ti !!!)
Dim Phone As String
Phone = TxtTéléphone.Text
Select Case Len(Phone)
Case 2, 5, 8, 11, 14
Phone = Phone & ' '
End Select
TxtTéléphone.Text = Phone
End Sub

'====================================================================================
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<CHANGEMENT>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub CommandButton3_Click() 'LANCEMENT MODE MAJ
With TxtSection
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtNom
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtPrénom
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxSexe
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtAdresse
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtCodePostal
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxVilles
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtTéléphone
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtTélPortable
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtEmail
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtDateDeNais
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtN°deLicence
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxAss
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With TxtMutation
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxCatégories1
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxCatégories2
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxCatégories3
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxPaiements
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
With CbxAutreSection
.Enabled = True
.BackColor = RGB(204, 255, 255)
End With
USF_Saisie_Adhérents.Caption = 'SMD Section Basket => MODE MISE A JOUR'
CmdNouveau.Visible = False
CommandButton5.Visible = True
CommandButton6.Visible = False
CommandButton8.Visible = True
Frame1.Visible = False
USF_Saisie_Adhérents.BackColor = RGB(51, 204, 204)
Frame1.BackColor = RGB(51, 204, 204)
LblNom.BackColor = RGB(255, 220, 245)
LblPrénom.BackColor = RGB(255, 220, 245)
LblSexe.BackColor = RGB(255, 220, 245)
TxtSection.SetFocus
End Sub

Private Sub CommandButton5_Click() 'MODE MAJ VALIDATION MAJ
Dim Msg As String
ListBox1.Value = ''
If TxtNom = '' Then
MsgBox 'Votre Contact n'a pas de nom ? ', _
vbCritical, 'SMD Section Basket = Mode Nouveau Validation Error'
Exit Sub
End If
If TxtNom = '' And TxtPrénom = '' Then
MsgBox 'Votre Contact doit au minimu avoir un Nom ou un Prénom', _
vbCritical, 'SMD Section Basket = Mode Nouveau Validation Error'
Exit Sub
End If
With Sheets('Detail')
.Range('A' & NomLBindex).Value = TxtSection.Value
.Range('B' & NomLBindex).Value = TxtNom.Value
.Range('C' & NomLBindex).Value = TxtPrénom.Value
.Range('D' & NomLBindex).Value = CbxSexe.Value
.Range('E' & NomLBindex).Value = TxtAdresse.Value
.Range('F' & NomLBindex).Value = TxtCodePostal.Value
.Range('G' & NomLBindex).Value = CbxVilles.Value
.Range('H' & NomLBindex).Value = TxtTéléphone.Value
.Range('I' & NomLBindex).Value = TxtTélPortable.Value
.Range('J' & NomLBindex).Value = TxtEmail.Value
.Range('K' & NomLBindex).Value = TxtDateDeNais.Value
.Range('L' & NomLBindex).Value = TxtN°deLicence.Value
.Range('M' & NomLBindex).Value = CbxAss.Value
.Range('N' & NomLBindex).Value = TxtMutation.Value
.Range('O' & NomLBindex).Value = CbxCatégories1.Value
.Range('P' & NomLBindex).Value = CbxCatégories2.Value
.Range('Q' & NomLBindex).Value = CbxCatégories3.Value
.Range('R' & NomLBindex).Value = CbxPaiements.Value
.Range('S' & NomLBindex).Value = CbxAutreSection.Value
End With

MsgBox TxtNom & ' à bien été mis à jour ' _
& vbCrLf & vbCrLf & vbTab & 'Nom = ' & vbTab & TxtNom _
& vbCrLf & vbCrLf & vbTab & 'Prénom= ' & vbTab & TxtPrénom, _
vbInformation, 'SMD Section Basket => Mode Mise à Jour Accomplie'

'& vbCrLf & vbCrLf & vbTab & 'Catégorie = ' & vbTab & CbxCatégories1, _

Msg = MsgBox('Voulez-vous continuer pour d'autres Mise à Jours ?', _
vbYesNo, 'SMD Section Basket => Mode Nouveau Continuer ?')
If Msg = vbNo Then
TxtSection = ''
TxtNom = ''
TxtPrénom = ''
CbxSexe.Visible = True
TxtAdresse = ''
TxtCodePostal = ''
CbxVilles = ''
TxtTéléphone = ''
TxtTélPortable = ''
TxtEmail = ''
TxtDateDeNais = ''
TxtN°deLicence = ''
CbxAss = ''
TxtMutation = ''
CbxCatégories1 = ''
CbxCatégories2 = ''
CbxCatégories3 = ''
CbxPaiements = ''
CbxAutreSection = ''
Unload Me
USF_Saisie_Adhérents.Show
End If

End Sub
Private Sub CommandButton8_Click() 'MODE SUPRESSION MAJ
Dim Msg As String
Msg = MsgBox('Etes-vous sur de vouloir supprimer ' _
& vbCrLf & vbCrLf & vbTab & TxtNom & ' ?', vbYesNo, 'SMD Section Basket => Mode Suppression Contact ???')
If Msg = vbYes Then
ListBox1.Value = ''
With Sheets('Detail')
.Range('A' & NomLBindex).Value = ''
.Range('B' & NomLBindex).Value = ''
.Range('C' & NomLBindex).Value = ''
.Range('D' & NomLBindex).Value = ''
.Range('E' & NomLBindex).Value = ''
.Range('F' & NomLBindex).Value = ''
.Range('G' & NomLBindex).Value = ''
.Range('H' & NomLBindex).Value = ''
.Range('I' & NomLBindex).Value = ''
.Range('J' & NomLBindex).Value = ''
.Range('K' & NomLBindex).Value = ''
.Range('L' & NomLBindex).Value = ''
.Range('M' & NomLBindex).Value = ''
.Range('N' & NomLBindex).Value = ''
.Range('O' & NomLBindex).Value = ''
.Range('P' & NomLBindex).Value = ''
.Range('Q' & NomLBindex).Value = ''
.Range('R' & NomLBindex).Value = ''
.Range('S' & NomLBindex).Value = ''
End With
'******************* Ici, on supprime la ligne dans la feuille 'Paiements'.
'ListBox1SB.Value = ''
With Sheets('Paiements')
.Range('A' & NomLBindex).Value = ''
.Range('B' & NomLBindex).Value = ''
.Range('C' & NomLBindex).Value = ''
.Range('D' & NomLBindex).Value = ''
.Range('E' & NomLBindex).Value = ''
.Range('F' & NomLBindex).Value = ''
.Range('G' & NomLBindex).Value = ''
.Range('H' & NomLBindex).Value = ''
.Range('I' & NomLBindex).Value = ''
.Range('J' & NomLBindex).Value = ''
.Range('K' & NomLBindex).Value = ''
.Range('L' & NomLBindex).Value = ''
.Range('M' & NomLBindex).Value = ''
.Range('N' & NomLBindex).Value = ''
.Range('O' & NomLBindex).Value = ''
.Range('P' & NomLBindex).Value = ''
.Range('Q' & NomLBindex).Value = ''
.Range('R' & NomLBindex).Value = ''

End With
'********************
Unload Me
USF_Saisie_Adhérents.Show
End If

End Sub

'====================================================================================
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<CHANGEMENT>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub CommandButton6_Click() 'MODE RECHERCHE DIVERSE
Frame1.Visible = True
CmdNouveau.Visible = False
CommandButton3.Visible = False
CommandButton4.Visible = False
CommandButton5.Visible = False
TxtRecherche.SetFocus
End Sub

Private Sub SortNom()

Range('A6:S200').Select
Selection.Sort Key1:=Range('B6'), Order1:=xlAscending, Key2:=Range('C6') _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range('B5').Select
Sheets('Paiements').Select
Range('A6:R200').Select
Selection.Sort Key1:=Range('A6'), Order1:=xlAscending, Key2:=Range('B6') _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range('A5').Select
Sheets('Detail').Select
End Sub


'Dim L As Integer
'Dim Plage As Range
'L = Sheets('Detail').Range('A65536').End(xlUp).Row
'Set Plage = Sheets('Detail').Range('A6:S' & L)
'Plage.Sort Worksheets('Detail').Columns('B'), _
'Order1:=xlAscending, Header:=xlGuess

'L = Sheets('Paiements').Range('A65536').End(xlUp).Row
'Set Plage = Sheets('Paiements').Range('A6:R' & L)
'Plage.Sort Worksheets('Paiements').Columns('A'), _
'Order1:=xlAscending, Header:=xlGuess

'End Sub

Private Sub CommandButton2_Click() 'MODE RECHERCHE STRING
Dim Cherche As String
Dim L As Integer
Dim Maplage As Range
Dim FirstADdress As String
Dim B As Object
Cherche = TxtRecherche
If Cherche = '' Then
Exit Sub
End If
ListBox1.Visible = False
ListBox2.Visible = True
USF_Saisie_Adhérents.Caption = 'SMD Section Basket Mode Recherche par chaîne de caractères'

L = Sheets('Detail').Range('A65536').End(xlUp).Row
Set Maplage = Sheets('Detail').Range('A6:B' & L)
With Maplage
Set B = .Find(Cherche, LookIn:=xlValues)
If Not B Is Nothing Then
FirstADdress = B.Address
Do
ListBox2.AddItem B
Set B = .FindNext(B)
Loop While Not B Is Nothing And B.Address <> FirstADdress
End If
End With
End Sub

Private Sub ListBox2_Click() 'MODE RETOUR VALEUR RECHERCHEE
Dim ReCherche As String
Dim L As Integer
Dim Plage As Range
Dim Cell As Range
Dim maille As Boolean
ReCherche = ListBox2.Value
L = Sheets('Detail').Range('A65536').End(xlUp).Row
Set Plage = Sheets('Detail').Range('A6:S' & L)
For Each Cell In Plage
If Cell.Value = ReCherche Then
LRecherche = Cell.Row
End If
Next Cell
TxtRecherche = ''
TxtSection = Sheets('Detail').Range('A' & LRecherche)
TxtNom = Sheets('Detail').Range('B' & LRecherche)
TxtPrénom = Sheets('Detail').Range('C' & LRecherche)
CbxSexe = Sheets('Detail').Range('D' & LRecherche)
TxtAdresse = Sheets('Detail').Range('E' & LRecherche)
TxtCodePostal = Sheets('Detail').Range('F' & LRecherche)
CbxVilles = Sheets('Detail').Range('G' & LRecherche)
TxtTéléphone = Sheets('Detail').Range('H' & LRecherche)
TxtTélPortable = Sheets('Detail').Range('I' & LRecherche)
TxtEmail = Sheets('Detail').Range('J' & LRecherche)
TxtDateDeNais = Format(Sheets('Detail').Range('K' & LRecherche), 'd-mmm-yy')
TxtN°deLicence = Sheets('Detail').Range('L' & LRecherche)
CbxAss = Sheets('Detail').Range('M' & LRecherche)
TxtMutation = Sheets('Detail').Range('N' & LRecherche)
CbxCatégories1 = Sheets('Detail').Range('O' & LRecherche)
CbxCatégories2 = Sheets('Detail').Range('P' & LRecherche)
CbxCatégories3 = Sheets('Detail').Range('Q' & LRecherche)
CbxPaiements = Sheets('Detail').Range('R' & LRecherche)
CbxAutreSection = Sheets('Detail').Range('S' & LRecherche)
TxtRecherche = ''

USF_Saisie_Adhérents.Caption = 'SMD Section Basket Mode Recherche par chaîne de caractère'
CommandButton6.Visible = False
CommandButton9.Visible = True
CommandButton10.Visible = True
'TextBox5.Visible = True
End Sub


Private Sub CommandButton9_Click() 'MODE VALIDATION MAJ DEPUIS RECHERCHE
With TxtSection
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtNom
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtPrénom
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxSexe
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtAdresse
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtCodePostal
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxVilles
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtTéléphone
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtTélPortable
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtEmail
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtDateDeNais
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With TxtN°deLicence
.Enabled = True
.BackColor = RGB(255, 200, 200)
With CbxAss
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
End With
With TxtMutation
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxCatégories1
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxCatégories2
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxCatégories3
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxPaiements
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
With CbxAutreSection
.Enabled = True
.BackColor = RGB(255, 200, 200)
End With
USF_Saisie_Adhérents.BackColor = RGB(255, 128, 128)
Frame1.BackColor = RGB(255, 128, 128)
CommandButton11.Visible = True

End Sub
Private Sub CommandButton11_Click()
ListBox1.Value = ''
If TxtNom = '' Then
MsgBox 'Vous ne pouvez pas supprimmer le nom du Contact ! ', _
vbCritical, 'SMD Section Basket = Mode Mise à Jour Validation Error'
Exit Sub
End If
If TxtPrénom = '' Then
MsgBox 'Votre Contact doit au minimu avoir un Prénom ', _
vbCritical, 'SMD Section Basket = Mode Nouveau Validation Error'
Exit Sub
End If
With Sheets('Detail')
.Range('A' & LRecherche).Value = TxtSection.Value
.Range('B' & LRecherche).Value = TxtNom.Value
.Range('C' & LRecherche).Value = TxtPrénom.Value
.Range('D' & LRecherche).Value = CbxSexe.Value
.Range('E' & LRecherche).Value = TxtAdresse.Value
.Range('F' & LRecherche).Value = TxtCodePostal.Value
.Range('G' & LRecherche).Value = CbxVilles.Value
.Range('H' & LRecherche).Value = TxtTéléphone.Value
.Range('I' & LRecherche).Value = TxtTélPortable.Value
.Range('J' & LRecherche).Value = TxtEmail.Value
.Range('K' & LRecherche).Value = TxtDateDeNais.Value
.Range('L' & LRecherche).Value = TxtN°deLicence.Value
.Range('M' & LRecherche).Value = CbxAss.Value
.Range('N' & LRecherche).Value = TxtMutation.Value
.Range('O' & LRecherche).Value = CbxCatégories1.Value
.Range('P' & LRecherche).Value = CbxCatégories2.Value
.Range('Q' & LRecherche).Value = CbxCatégories3.Value
.Range('R' & LRecherche).Value = CbxPaiements.Value
.Range('S' & LRecherche).Value = CbxAutreSection.Value
End With

MsgBox TxtNom & ' à bien été mis à jour ' _
& vbCrLf & vbCrLf & vbTab & 'Nom = ' & vbTab & TxtNom _
& vbCrLf & vbCrLf & vbTab & 'Prénom = ' & vbTab & TxtPrénom _
& vbCrLf & vbCrLf & vbTab & 'Catégorie = ' & vbTab & CbxCatégories1, _
vbInformation, 'SMD Section Basket => Mode Mise à Jour Accomplie'
Unload Me
USF_Saisie_Adhérents.Show
End Sub


Private Sub CommandButton10_Click() 'MODE SUPRESSION MAJ DEPUIS RECHERCHE
Dim Msg As String
Msg = MsgBox('Etes-vous sur de vouloir supprimer ' _
& vbCrLf & vbCrLf & vbTab & TxtNom & ' ?', vbYesNo + vbQuestion, _
'SMD Section Basket => Mode Supression Contact ???')
If Msg = vbYes Then
ListBox1.Value = ''
With Sheets('Detail')
.Range('A' & LRecherche).Value = ''
.Range('B' & LRecherche).Value = ''
.Range('C' & LRecherche).Value = ''
.Range('D' & LRecherche).Value = ''
.Range('E' & LRecherche).Value = ''
.Range('F' & LRecherche).Value = ''
.Range('G' & LRecherche).Value = ''
.Range('H' & LRecherche).Value = ''
.Range('I' & LRecherche).Value = ''
.Range('J' & LRecherche).Value = ''
.Range('K' & LRecherche).Value = ''
.Range('L' & LRecherche).Value = ''
.Range('M' & LRecherche).Value = ''
.Range('N' & LRecherche).Value = ''
.Range('O' & LRecherche).Value = ''
.Range('P' & LRecherche).Value = ''
.Range('Q' & LRecherche).Value = ''
.Range('R' & LRecherche).Value = ''
.Range('S' & LRecherche).Value = ''
End With
With Sheets('Paiements')
.Range('A' & LRecherche).Value = ''
.Range('B' & LRecherche).Value = ''
.Range('C' & LRecherche).Value = ''
.Range('D' & LRecherche).Value = ''
.Range('E' & LRecherche).Value = ''
.Range('F' & LRecherche).Value = ''
.Range('G' & LRecherche).Value = ''
.Range('H' & LRecherche).Value = ''
.Range('I' & LRecherche).Value = ''
.Range('J' & LRecherche).Value = ''
.Range('K' & LRecherche).Value = ''
.Range('L' & LRecherche).Value = ''
.Range('M' & LRecherche).Value = ''
.Range('N' & LRecherche).Value = ''
.Range('O' & LRecherche).Value = ''
.Range('P' & LRecherche).Value = ''
.Range('Q' & LRecherche).Value = ''
.Range('R' & LRecherche).Value = ''



End With

Unload Me
USF_Saisie_Adhérents.Show
End If
End Sub

Private Sub CommandButton7_Click() ' REINITIALISATION COMPLETE
Unload Me
USF_Saisie_Adhérents.Show
End Sub

Private Sub F_Click()

End Sub


Merci
Jipé
 
Vote positif 0 Vote négatif

Discussions similaires

Usine à gaz
  • Résolu(e)
XL 2021 Rechercher dans plusieurs fichiers
2
Réponses
18
Affichages
854
Usine à gaz
Usine à gaz
F
  • Question
XL 2019 Extraire des lignes suivant somme des colonnes pour alimenter un autre tableau
Réponses
1
Affichages
247
fanfan38
fanfan38
O
  • Question
XL 2021 Mise à jour automatique d'une feuille à partir d'une autre
Réponses
9
Affichages
390
Oca
O
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
416
Messan
Messan
J
  • Question
Microsoft 365 extraction VBA avec formule si
Réponses
10
Affichages
368
Phil69970
Phil69970
E
  • Question
Power Query grouper plusieurs feuilles qui n'ont pas le même format avec normalisation des noms des entêtes
Réponses
5
Affichages
695
mromain
mromain
R
  • Résolu(e)
XL 2021 Macro copier-coller colonnes précédentes
Réponses
12
Affichages
410
Retraite
R
D
  • Question
XL 2016 Exporter au format PDF dans un dossier existant les colonnes ciblées et en filtrant les lignes qui contiennent une valeur quelconque.
Réponses
6
Affichages
415
Phil69970
Phil69970
M
  • Résolu(e)
XL 2016 besoin d'aide
2
Réponses
17
Affichages
1 K
marc94600
M
E
  • Résolu(e)
XL 2019 Formule matricielle et référence structurée
Réponses
7
Affichages
250
chris
chris

Membres actuellement en ligne

10 membres et 152 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 386
Messages
2 087 853
Membres
103 669
dernier inscrit
Anne Sicard