Doubler des infos d'un UserForm

[JPS28]

Bonjour.
Une petite question pour vous les spécialistes du VBA comment doubler des informations que l'on inscrit dans un UserForm d'un classeur pour les copiers dans une autre colonne d'une autre feuille dans un autre classeur ?
Merci de vos propositions.
Cordialement.
JPS.

 

[Guest]

Re : Doubler des infos d'un UserForm

Bonjour JPS,

WorkBooks("[COLOR=red]DeuxiemeClasseur[/COLOR]").Sheets("[COLOR=blue]AutreFeuille[/COLOR]").Range("A1")=TextBox1.Text

Copiera la valeur de TextBox1 dans la cellule 'A1' de la feuille 'AutreFeuille' du 'DeuxièmeClasseur' si celui-ci est ouvert.

A bientôt

 

[JPS28]

Re : Doubler des infos d'un UserForm

Bonjour Hasco, le forum.
Je vais essayer cela entre deux coups de pinceaux, je te remercie de ton coup de main. Une autre petite question a quel niveau de la macro de l'UserForm je mets cette commande ? Merci.
A+

 

[Guest]

Re : Doubler des infos d'un UserForm

Re bonjour JPS,

Pour répondre plus précisément il faudrait, la macro, ainsi que le nom du deuxième classeur, le nom de la feuille et l'adresse de cellule de destination.

A bientôt

 

[JPS28]

Re : Doubler des infos d'un UserForm

Re
Une entracte pour te répondre la voici la macro :

Private Sub Frame1_Click()

End Sub

Private Sub txtAdresse1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtAdresse1.Value = Trim(txtAdresse1.Value)
End Sub

Private Sub txtAdresse2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtAdresse2.Value = Trim(txtAdresse2.Value)
End Sub

Private Sub txtCivilite_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtCivilite.Value = Trim(txtCivilite.Value)
End Sub

Private Sub txtCode_Change()
' Activer le bouton Valider
Call ActiverBtnValider
End Sub

Private Sub txtCode_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtCode.Value = Application.WorksheetFunction.Proper(Trim(txtCode.Value))
End Sub

Private Sub txtCP_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtCP.Value = Trim(txtCP.Value)
End Sub

Private Sub txtNom_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtNom.Value = UCase(Trim(txtNom.Value))
End Sub

Private Sub txtPrenom_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtPrenom.Value = Application.WorksheetFunction.Proper(Trim(txtPrenom.Value))
End Sub
Private Sub txtCavalier_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtCavalier.Value = Trim(txtCavalier.Value)
End SubPrivate Sub txtTel_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtTel.Value <> "" Then txtTel.Value = Format(txtTel.Value, "00 00 00 00 00")
End Sub

Private Sub txtTel_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If txtTel.Value <> "" Then txtTel.Value = Format(txtTel.Value, "00 00 00 00 00")
End Sub

Private Sub txtVille_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtVille.Value = UCase(Trim(txtVille.Value))
End Sub

Private Sub UserForm_Initialize()
Dim wsFClient As Worksheet
Dim Ctrl As Byte

Set wsFClient = Worksheets("Clients")

' Initialiser les zones
Call InitZones

' Si Ajout : Rechercher le n° client suivant
If TypeSaisie = 1 Then
lblNumClient.Caption = RechercherNumClient

' Si modification : afficher les données
ElseIf TypeSaisie = 2 Then
cmbTypeClient.Value = wsFClient.Range("A" & LigClient).Value
cmbTypeClient.Enabled = False
txtCode.Value = wsFClient.Range("B" & LigClient).Value
lblNumClient.Caption = wsFClient.Range("C" & LigClient).Value
txtCivilite.Value = wsFClient.Range("D" & LigClient).Value
txtNom.Value = wsFClient.Range("E" & LigClient).Value
txtPrenom.Value = wsFClient.Range("F" & LigClient).Value
txtCavalier.Value = wsFClient.Range("G" & LigClient).Value
txtAdresse1.Value = wsFClient.Range("H" & LigClient).Value
txtAdresse2.Value = wsFClient.Range("I" & LigClient).Value
txtCP.Value = wsFClient.Range("J" & LigClient).Value
txtVille.Value = wsFClient.Range("K" & LigClient).Value
txtTel.Value = wsFClient.Range("L" & LigClient).Value

' Réf
For Ctrl = 1 To 4
If wsFClient.Cells(LigClient, 12 + Ctrl).Value <> "" Then
Controls("cmbRef" & Ctrl).Value = wsFClient.Cells(LigClient, 12 + Ctrl).Value
End If
Next Ctrl
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

Private Sub InitZones()
' Initialiser les zones
Dim Ctrl As Byte

cmbTypeClient.Clear
cmbTypeClient.AddItem "Pension"
cmbTypeClient.AddItem "Reprises"
cmbTypeClient.AddItem "Pension/Reprises"
cmbTypeClient.AddItem "Divers"
cmbTypeClient.Value = ""

txtCode.Value = ""
lblNumClient.Caption = ""
txtCivilite.Value = ""
txtNom.Value = ""
txtPrenom.Value = ""
txtAdresse1.Value = ""
txtAdresse2.Value = ""
txtCP.Value = ""
txtVille.Value = ""
txtTel.Value = ""

For Ctrl = 1 To 4
Controls("cmbRef" & Ctrl).Clear
Next Ctrl
cmbRef1.List = Worksheets("Réf").Range("Réf").Value
End Sub

Private Function RechercherNumClient() As String
' Rechercher le n° du client
Dim wsFClient As Worksheet
Dim derLig As Long
Dim Plage As Range, Cell As Range
Dim adresseCell As String

Set wsFClient = Worksheets("Clients")

' Dernière ligne en colonne C
derLig = wsFClient.Range("C" & Cells.Rows.Count).End(xlUp).Row

' Plage de cellules
Set Plage = wsFClient.Range("C2:C" & derLig)
' Rechercher le n° client dans la plage de cellules
Set Cell = Plage.Find(Format(Now, "ddmmyyyy"), , LookIn:=xlValues, LookAt:=xlPart)

' Si le n° est trouvé
If Not Cell Is Nothing Then
adresseCell = Cell.Address

Do
If RechercherNumClient = "" Then
RechercherNumClient = Cell.Value
ElseIf CLng(Cell.Value) > CLng(RechercherNumClient) Then
RechercherNumClient = Cell.Value
End If

Set Cell = Plage.FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address <> adresseCell

End If

If RechercherNumClient <> "" Then
RechercherNumClient = Format(Now, "ddmmyyyy") & _
CInt(Mid(RechercherNumClient, 9, Len(RechercherNumClient) - 8)) + 1
Else
RechercherNumClient = Format(Now, "ddmmyyyy") & "1"
End If
End Function

Private Sub ActiverBtnValider()
' Activer le bouton Valider

cmdValider.Enabled = False
If cmbTypeClient.Value <> "" And txtCode.Value <> "" Then
cmdValider.Enabled = True
End If
End Sub

Private Function RechercherCode() As Boolean
' Rechercher l'existence du code client
Dim wsFClient As Worksheet
Dim derLig As Long
Dim Plage As Range, Cell As Range

RechercherCode = False

Set wsFClient = Worksheets("Clients")

' Dernière ligne en colonne B
derLig = wsFClient.Range("B" & Cells.Rows.Count).End(xlUp).Row
If derLig < 2 Then derLig = 2

' Sélection de la plage de cellules des codes clients
Set Plage = wsFClient.Range("B2:B" & derLig)

' Rechercher le code client dans la plage
Set Cell = Plage.Find(txtCode.Value, , LookIn:=xlValues, LookAt:=xlWhole)
' Si le code est trouvé
If Not Cell Is Nothing Then
If Cell.Row <> LigClient Then RechercherCode = True
End If
End Function

Private Sub SaisieClientFacture(TypeClient As String, NumClient As String)
' Ajouter ou modifier un client dans la liste des factures
Dim wsFact As Worksheet
Dim derLig As Long
Dim derCol As String
Dim Plage As Range, Cell As Range
Dim LigSaisie As Long

' Choix de la feuille de suivi de factures en fonction du type de client
If TypeClient = "Pension" Then
Set wsFact = Worksheets("SUIVI FACTURE PENSION")
derCol = "U"
ElseIf TypeClient = "Reprises" Then
Set wsFact = Worksheets("SUIVI FACTURE REPRISES")
derCol = "N"
ElseIf TypeClient = "Pension/Reprises" Then
Set wsFact = Worksheets("SUIVI FACTURE PENSION-REPRISES")
derCol = "AA"
ElseIf TypeClient = "Divers" Then
Set wsFact = Worksheets("SUIVI FACTURE DIVERS")
derCol = "N"
Else: Exit Sub
End If

With wsFact
' Dernière ligne en colonne A
derLig = .Range("A" & Cells.Rows.Count).End(xlUp).Row
If derLig < 5 Then derLig = 5

' Déterminer la plage de cellules
Set Plage = wsFact.Range("A5:A" & derLig)

' Rechercher le n° client dans la feuille Facture
Set Cell = Plage.Find(NumClient, , LookIn:=xlValues, LookAt:=xlWhole)
' Le n° Client est trouvé
If Not Cell Is Nothing Then
LigSaisie = Cell.Row
Else
derLig = derLig + 1
LigSaisie = derLig
End If

' Enregistrer les données dans la feuille Facture
.Range("A" & LigSaisie).NumberFormat = "@"
.Range("A" & LigSaisie).Value = NumClient
.Range("B" & LigSaisie).Value = txtNom.Value
.Range("C" & LigSaisie).Value = txtPrenom.Value
.Range("D" & LigSaisie).Value = txtAdresse1.Value & IIf(txtAdresse2.Value <> "", " " & txtAdresse2.Value, "")
.Range("E" & LigSaisie).Value = txtCP.Value
.Range("F" & LigSaisie).Value = txtVille.Value
.Range("G" & LigSaisie).NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##"
.Range("G" & LigSaisie).Value = txtTel.Value

' En mode Ajout : Mettre des bordures et un fond rouge
If TypeSaisie = 1 Then
If TypeClient <> "Pension/Reprises" Then
Set Plage = .Range("H" & LigSaisie & ":" & derCol & LigSaisie)
Call Bordures(Plage, xlEdgeLeft)
Call Bordures(Plage, xlEdgeTop)
Call Bordures(Plage, xlEdgeBottom)
Call Bordures(Plage, xlEdgeRight)
Call Bordures(Plage, xlInsideVertical)
Plage.Interior.ColorIndex = 3
Else
Set Plage = .Range("H" & LigSaisie & ":U" & LigSaisie)
Call Bordures(Plage, xlEdgeLeft)
Call Bordures(Plage, xlEdgeTop)
Call Bordures(Plage, xlEdgeBottom)
Call Bordures(Plage, xlEdgeRight)
Call Bordures(Plage, xlInsideVertical)
Plage.Interior.ColorIndex = 3

Set Plage = .Range("W" & LigSaisie & ":" & derCol & LigSaisie)
Call Bordures(Plage, xlEdgeLeft)
Call Bordures(Plage, xlEdgeTop)
Call Bordures(Plage, xlEdgeBottom)
Call Bordures(Plage, xlEdgeRight)
Call Bordures(Plage, xlInsideVertical)
Plage.Interior.ColorIndex = 3
End If
End If

' Trier les données
Set Plage = .Range("A5:" & derCol & derLig)
Plage.Sort _
Key1:=.Range("B5"), Order1:=xlAscending, _
Key2:=.Range("C5"), Order2:=xlAscending, _
Key3:=.Range("A5"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False ', Orientation:=xlTopToBottom, _
'DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal

' Afficher le nombre de clients dans la liste
.Range("B2").Formula = "=COUNTA(A5:A" & derLig & ")"
End With
End Sub
Je souhaiterai que le nom du cavalier s'incrive aussi dans le classeur FormCavalierCheval,feuille:monte,colonne H, et comme se sont des inscriptions je souhaiterais que les noms se mets les aprés les autres.
Merci.
A+

 

[Guest]

Re : Doubler des infos d'un UserForm

Re Jps,

Euh😕!!!!!! il aurait peut-être été plus simple de joindre un fichier avec quelques données anonymisées?

Mais bon, il me semble qu'il faille faire les modifications suivantes:

A rajouter en bas de macro avant End Sub

With WorkBooks(Workbooks("FormCavalierCheval").Sheets("monte")
   derLig=.range("H" & .Rows.Count).End(xlUp).Row
   .Range("H" & derLig+1).Value= txtNom.Value
End With

Si cela ne convient pas, joindre le fichier avec quelques données.
Je rappèle que le classeur FormCavalierCheval doit être ouvert et la feuille existante dans le classeur.

A bientôt

 

[JPS28]

Re : Doubler des infos d'un UserForm

Bonjour Hasco, le forum.
Je te remercie de m'avoir proposé une solution je suis en train de faire des essais pour apprendre a me débrouiller avec le VBA je te tiens au courant de mes avancements. Merci.
Cordialement.
JPS.

 

[JPS28]

Re : Doubler des infos d'un UserForm

Bonsoir Hasco, le forum.
Aprés plusieurs essais j'ai reussi a faire cette phrase qui fonctionne bien,
' Enregistrer les données dans le classeur formcavaliercheval dans la feuille Cavaliers
Workbooks("formcavaliercheval").Sheets("Cavaliers").Range("B2") = txtCavalier.Value
mais je souhaiterais que les données s'inscrivent l'une aprés l'autres car j'ai plusieurs inscriptions de cavaliers que dois-je faire pour que cela fonctionne et j'ai aussi un txtGalop que je souhaitrerais inscrire en même temps en colonne A?
Cordialement.
JPS

 

[Guest]

Re : Doubler des infos d'un UserForm

Bonjour JPS,

Avec ceci comme dans mon message précédent, il n'y a que le nom de la feuille qui change et la lettre de la colonne (B).

La variable derLig doit être déclarer en tête de procédure comme suit:

Dim [COLOR=seagreen][B]derLig[/B][/COLOR] As Long
 
'...autres lignes de code
 
'On travaille sur le classeur FormCavalierCheval et la feuille Cavalier
With WorkBooks(Workbooks("FormCavalierCheval").Sheets("Cavaliers")
 
   'Récupère le numéro de la dernière ligne dans la feuille, colonne [COLOR=blue][B]B[/B][/COLOR]
   [COLOR=seagreen][B]derLig[/B][/COLOR]=.range("[COLOR=blue][B]B[/B][/COLOR]" & .Rows.Count).End(xlUp).Row
 
   'Place la valeur dans la cellule de la colonne B, ligne derLig+1
   .Range("[COLOR=blue][B]B[/B][/COLOR]" & [B][COLOR=seagreen]derLig[/COLOR][COLOR=red]+1[/COLOR][/B]).Value= txtCavalier.Value
 
End With
 
'...Autres lignes de code

A bientôt

 

[JPS28]

Re : Doubler des infos d'un UserForm

Bonsoir Vasco, le forum.
D'abord je te remercie et suis content de te retrouver. Etant novice comme je te l'ai déjà dis, j'ai deux ou trois questions à te poser sur ton code faisant du copier coller.

Dim derLig As Long

'...autres lignes de code? tu fais allusion a quelles lignes de code?

'On travaille sur le classeur FormCavalierCheval et la feuille Cavalier
With WorkBooks(Workbooks("FormCavalierCheval").Sheets("Cavaliers") Pourquoi cette ligne s'affiche en rouge quand je la colle?

'Récupère le numéro de la dernière ligne dans la feuille, colonne B
derLig=.range("B" & .Rows.Count).End(xlUp).Row

'Place la valeur dans la cellule de la colonne B, ligne derLig+1
.Range("B" & derLig+1).Value= txtCavalier.Value que veux dire derLig ?

End With


'...Autres lignes de code

Merci.
A+

 

[Guest]

Re : Doubler des infos d'un UserForm

Bonjour JPS,


A strictement parler, ces lignes de codes ne font pas du copier-coller, qui est autre chose. Ces lignes récupèrent la valeur d'un textbox (txtCavalier) pour la placer dans une cellule de feuille de calcul. Tout cela s'entend, sur la base du travail que nous avons fait précédement.

'Déclaraction de la variable derLig qui contiendra le numéro de la dernière 'ligne reseignée de la plage de cellule

Dim [COLOR=seagreen][B]derLig[/B][/COLOR] As Long
 
'...autres lignes de code: les autre lignes de ta macro (s'il y en a)
 
'On travaille sur le classeur FormCavalierCheval et la feuille Cavalier
'Sur cette ligne, c'est moi qui ai fait une erreur en répetant 2 fois 'Workbooks(' --> corrigé:

With [COLOR=seagreen]Workbooks("FormCavalierCheval").Sheets("Cavaliers")
[/COLOR] 
   'Récupère le numéro de la dernière ligne dans la feuille, colonne [COLOR=blue][B]B[/B][/COLOR]
   [COLOR=seagreen][B]derLig[/B][/COLOR]=.range("[COLOR=blue][B]B[/B][/COLOR]" & .Rows.Count).End(xlUp).Row
 
   'Place la valeur dans la cellule de la colonne B, ligne derLig+1
   .Range("[COLOR=blue][B]B[/B][/COLOR]" & [B][COLOR=seagreen]derLig[/COLOR][COLOR=red]+1[/COLOR][/B]).Value= txtCavalier.Value
 
End With
 
'...Autres lignes de code de la macro, s'il y en a, bien-sûr

A bientôt

 

[JPS28]

Re : Doubler des infos d'un UserForm

Bonsoir Hasco, le forum.
Je te remercie de tout tes conseils je suis arrivé a faire cette liaison grâce à toi une dernière petite question et j'en aurais terminé avec cette liaison comment pourrais-je éliminer ou modifier le cavalier que j'ai inscris dans le fichier forncavaliercheval en même temps que je le modifie ou que je l'élimine sur mon fichier client? Je veux apprendre mais la je pense que c'est trop compliqué pour moi et je voudrais éviter de faire des bêtises.
Aussi, si je peux me permettre je vous souhaite un bon WK ensoleillé pour la rencontre Bretonne du moi d'Octobre.
Je te joints les fichiers.
Merci.Cordialement.
JPS.

 

[Guest]

Re : Doubler des infos d'un UserForm

Bonjour JPS,

C'est du beau du beau boulot que tu as fait là.

Pour trouver le cavalier correspondant au txtCavalier du userFrom 'saisieClient" tu peux écrire un code comme celui-ci:

Dans l'évènement initialize du userform tu as:

txtCavalier.Value = wsFClient.Range("G" & LigClient).Value

tu peux rajouter dessous:

txtCavalier.Tag=txtCavalier.Value

Ce qui conservera la valeur d'origine de txtCavalier.

Ensuite sur validation de la fiche tu peux faire un test des deux valeurs pour savoir si le cavalier a changé:

If txtCavalier.Text <> txtCavalier.Tag And txtCavailer.Text <> "" Then
        'Le cavalier a changé et n'est pas vide
        Dim c As Range                                'Référence à la cellule du cavalier dans le fichier formcavaliercheval dans la plage des noms de cavalier
 
        With Workbooks("formcavaliercheval.xls").Sheets("Cavaliers").Range("Cavaliers")
            Set c = .Find(txtCavalier.Text)
            If c Is Nothing Then                      'Le cavalier n'existe pas dans le fichier
                formcavaliercheval
                'Lignes de code pour le rajouter comme on a vu précédemment
            Else                                      'Il existe
                c.Value = txtCavalier.Text            'Modifcation de la cellule
            End If
 
        End With

Pour la suppression tu peux faire pareil en recherchant la cellule idoine et

If not c Is Nothing then 
c.EntireRow.Delete 'Suppression de la ligne entière de formcavaliercheval
End if

J'ai vu que tu avais une fonction 'RechercherCode'. Tu peux en écrire une pour le cavalier si tu as plusieurs recherche à faire:

Function RechercheCavalier( NomCavalier as string) [SIZE=3][COLOR=red]As Range[/COLOR][/SIZE]
    With Workbooks("formcavaliercheval.xls").Sheets("Cavaliers").Range("Cavaliers")
            Set RechercheCavalier = .Find(txtCavalier.Text)
    End with
End Function

Lorsque tu en as besoin tu peux ecrire par exemple:

Dim c as range
Set c=RechercheCavalier(txtCavalier.text)
If Not c IsNothing then
   '......
Else
   '......
End IF

A bientôt

 

[JPS28]

Re : Doubler des infos d'un UserForm

Bonsoir Hasco, le forum.
Excuse moi de te déranger encore une fois mais j'ai une ligne qui s'affiche rouge et je ne comprend pas pourquoi?
Cordialement
A+
JPS.
Private Sub ActiverBtnValider()
' Activer le bouton Valider

cmdValider.Enabled = False
If cmbTypeClient.Value <> "" And txtCode.Value <> "" Then
cmdValider.Enabled = True
txtCavalier.Text <> txtCavalier.Tag And txtCavailer.Text "" Then celle ci ?
'Le cavalier a changé et n'est pas vide
Dim c As Range
'Référence à la cellule du cavalier dans le fichier formcavaliercheval dans la plage des noms de cavalier

With Workbooks("formcavaliercheval.xls").Sheets("Cavaliers").Range("Cavaliers")
Set c = .Find(txtCavalier.Text)
If c Is Nothing Then
'Le cavalier n'existe pas dans le fichier
formcavaliercheval
'Lignes de code pour le rajouter comme on a vu précédemment
Else 'Il existe
c.Value = txtCavalier.Text 'Modifcation de la cellule
If Not c Is Nothing Then
c.EntireRow.Delete 'Suppression de la ligne entière de formcavaliercheval
End With
End If
End Sub

 

[Guest]

Re : Doubler des infos d'un UserForm

Bonjour JPS,

Il te manque le If de début de ligne:

[SIZE=3][COLOR=red]If[/COLOR][/SIZE] txtCavalier.Text <> txtCavalier.Tag And txtCavailer.Text <> "" Then

A bientôt