Re : Afficher valeur d'une textebox dans une autre
la pj ne passe pas!
ci joint les codes des 2 usf:
USF: "CréationFicheFournisseur
Private Sub CommandButton1_Click()
Unload CréationFicheFournisseur
NouvelleFicheSuite.Show
End Sub
Private Sub CommandButton13_Click()
CréationFicheFournisseur.Hide
Accueil.Show
End Sub
Private Sub CommandButton14_Click()
CréationFicheFournisseur.Hide
Accueil.Show
End Sub
Private Sub CommandButton2_Click()
CréationFicheFournisseur.Hide
NouvelleFiche1.Show
End Sub
Private Sub CommandButton3_Click()
' test s'il y a un nom de dossier dans la cellule "nom" !?
NomDuDossierNew$ = CréationFicheFournisseur.TextBox3.Value
If NomDuDossierNew$ = "" Then MsgBox "Aucun nom de dossier dans la cellule nommée [nom] !?", vbExclamation, "Erreur": Exit Sub
' confirmation
M$ = "Chemin de destination:" & vbLf & NomDuCheminFournisseursPhotos$ & vbLf & vbLf & _
"Créer le sous dossier [ " & NomDuDossierNew$ & " ] ?"
ReponseMsgBox = MsgBox(M$, vbExclamation + vbYesNo + vbDefaultButton2, "Création nouveau sous dossier")
If ReponseMsgBox <> vbYes Then Exit Sub
' suite... pour création
On Error GoTo ErrDossier
' test si NomDuCheminFournisseursPhotos$ existe !?
Chemin$ = NomDuCheminFournisseursPhotos$
If Dir(Chemin$, vbDirectory) = "" Then MsgBox Chemin$ & vbLf & "... n'existe pas !?", vbCritical, "Erreur chemin": Exit Sub
' test si sous dossier existe !?
DossierNew$ = NomDuCheminFournisseursPhotos$ & "\"
Rep$ = Dir(DossierNew$, vbDirectory) 'Extrait première entrée
Do While Rep$ <> ""
If Rep$ <> "." And Rep$ <> ".." Then
If (GetAttr(DossierNew$ & Rep$) And vbDirectory) = vbDirectory Then 'test si dossier !?
If LCase(Rep$) = LCase(NomDuDossierNew$) Then MsgBox "Le sous dossier [ " & NomDuDossierNew$ & " ] existe déjà !": Exit Sub
End If
End If
Rep$ = Dir 'Extrait entrée suivante
Loop
' création
CreationNew$ = NomDuCheminFournisseursPhotos$ & "\" & NomDuDossierNew$
MkDir CreationNew$
MsgBox "Dossier [ " & NomDuDossierNew$ & " ] créé !"
On Error GoTo 0: Exit Sub ' fin quitte
ErrDossier: '-------------------------------------------
M$ = "Erreur n°" & Str(Err.Number) & " générée par " & Err.Source & vbLf & Err.Description
MsgBox M$, vbCritical, "Erreur", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Sub
Private Sub Label3_Click()
End Sub
Private Sub CommandButton4_Click()
NomDuDossierNew$ = CréationFicheFournisseur.TextBox3.Value
If NomDuDossierNew$ = "" Then MsgBox "Aucun nom de dossier dans la cellule nommée [nom] !?", vbExclamation, "Erreur": Exit Sub
' confirmation
M$ = "Chemin de destination:" & vbLf & NomDuCheminDocuments$ & vbLf & vbLf & _
"Créer le sous dossier [ " & NomDuDossierNew$ & " ] ?"
ReponseMsgBox = MsgBox(M$, vbExclamation + vbYesNo + vbDefaultButton2, "Création nouveau sous dossier")
If ReponseMsgBox <> vbYes Then Exit Sub
' suite... pour création
On Error GoTo ErrDossier
' test si NomDuCheminFournisseursPhotos$ existe !?
Chemin$ = NomDuCheminFournisseursDocuments$
If Dir(Chemin$, vbDirectory) = "" Then MsgBox Chemin$ & vbLf & "... n'existe pas !?", vbCritical, "Erreur chemin": Exit Sub
' test si sous dossier existe !?
DossierNew$ = NomDuCheminFournisseursDocuments$ & "\"
Rep$ = Dir(DossierNew$, vbDirectory) 'Extrait première entrée
Do While Rep$ <> ""
If Rep$ <> "." And Rep$ <> ".." Then
If (GetAttr(DossierNew$ & Rep$) And vbDirectory) = vbDirectory Then 'test si dossier !?
If LCase(Rep$) = LCase(NomDuDossierNew$) Then MsgBox "Le sous dossier [ " & NomDuDossierNew$ & " ] existe déjà !": Exit Sub
End If
End If
Rep$ = Dir 'Extrait entrée suivante
Loop
' création
CreationNew$ = NomDuCheminFournisseursDocuments$ & "\" & NomDuDossierNew$
MkDir CreationNew$
MsgBox "Dossier [ " & NomDuDossierNew$ & " ] créé !"
On Error GoTo 0: Exit Sub ' fin quitte
ErrDossier: '-------------------------------------------
M$ = "Erreur n°" & Str(Err.Number) & " générée par " & Err.Source & vbLf & Err.Description
MsgBox M$, vbCritical, "Erreur", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Sub
Private Sub Label9_Click()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Me.Height = Application.Height: Me.Width = Application.Width
End Sub
USF: "NouvelleFicheSuite"
Public ReponseMsgBox As Variant, DonneesEnCours$, NomDeFeuilEnCours$
Private Sub CommandButton1_Click()
If NouvelleFicheSuite.TextBox1.Value = "" Then
MsgBox " Le champ SOCIETE est obligatoire . "
Exit Sub
Else
'créer
Dim NomDeFeuilEnCours As String, lidep1 As Integer, cellule As Range
NomDeFeuilEnCours = "basefournisseurs"
lidep1 = 2
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = NouvelleFicheSuite.TextBox1.Value
ActiveCell.Offset(0, 1).Value = NouvelleFicheSuite.TextBox11.Value
' gestion des nombres commençant par 0 avec " ' "
ActiveCell.Offset(0, 2).Value = "'" & NouvelleFicheSuite.TextBox2.Value
ActiveCell.Offset(0, 3).Value = "'" & NouvelleFicheSuite.TextBox3.Value
ActiveCell.Offset(0, 4).Value = NouvelleFicheSuite.TextBox4.Value
ActiveCell.Offset(0, 5).Value = "'" & NouvelleFicheSuite.TextBox5.Value
ActiveCell.Offset(0, 6).Value = NouvelleFicheSuite.TextBox6.Value
ActiveCell.Offset(0, 7).Value = "'" & NouvelleFicheSuite.TextBox7.Value
ActiveCell.Offset(0, 8).Value = NouvelleFicheSuite.TextBox8.Value
ActiveCell.Offset(0, 9).Value = NouvelleFicheSuite.TextBox18.Value
ActiveCell.Offset(0, 10).Value = NouvelleFicheSuite.TextBox19.Value
ActiveCell.Offset(0, 11).Value = NouvelleFicheSuite.TextBox12.Value
ActiveCell.Offset(0, 12).Value = NouvelleFicheSuite.TextBox17.Value
ActiveCell.Offset(0, 13).Value = NouvelleFicheSuite.TextBox13.Value
ActiveCell.Offset(0, 14).Value = NouvelleFicheSuite.TextBox14.Value
ActiveCell.Offset(0, 15).Value = NouvelleFicheSuite.TextBox15.Value
ActiveCell.Offset(0, 16).Value = NouvelleFicheSuite.TextBox16.Value
'ActiveWorkbook.Save
'MsgBox " La fiche est créée "
'comptage nb de fiches
'sortir
NouvelleFicheSuite.Hide
CréationFicheFournisseur.Show
End If
End Sub
Private Sub CommandButton2_Click()
Unload NouvelleFicheSuite
CréationFicheFournisseur.Show
End Sub
Private Sub ListBox1_Click()
CréationFicheFournisseur.TextBox3.Value = ListBox1.List(ListBox1.ListIndex)
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub TextBox1_AfterUpdate()
NouvelleFicheSuite.TextBox1.Value = CréationFicheFournisseur.TextBox3.Value
End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox12_Change()
TextBox12.Value = Range("DomaineActivité!B1").Value
End Sub
Private Sub TextBox13_Change()
End Sub
Private Sub NouvelleFicheSuite_Initialize()
Me.Height = Application.Height: Me.Width = Application.Width
End Sub
Private Sub TextBox14_Change()
End Sub
Private Sub TextBox17_Change()
End Sub
Private Sub TextBox20_Change()
NouvelleFicheSuite.TextBox20.Value = CréationFicheFournisseur.TextBox3.Value
End Sub
Private Sub UserForm_Click()
End Sub