userform en chantier

[philouis]

Bonjour les amis du forum et bravo pour vos conseils toujours très précieux pour les novices comme moi.
J’ai réalisé un premier formulaire (voir en cliquant sur le bouton adhésion) qui n’est sans doute pas parfait mais qui ma foi à l’air de fonctionner. Toutefois je n’ai pas trouvé l’astuce pour que dans le texbox appelé « COTISATION MOIS » les décimales soient prises en compte.

Par ailleurs je souhaiterais qu’en cliquant sur le bouton RESILIATION un nouveau module s’ouvre dans lequel une liste déroulante apparaisse uniquement avec les NOMS & PRENOMS, ainsi qu’un textbox DATE DE RESILIATION. Après avoir complété ce module « RESILIATION » il faudrait que la ligne concernée par la résiliation disparaisse automatiquement de la base appelée « BASE ACTIFS » pour être reportée dans la « BASE RESILIES »

Enfin j’aurais souhaité que les boutons de commandes « ADHESION » et « RESILIATION » soient sur une feuille différente de celle de la base : je sais que c’est possible mais je n’arrive pas à le faire.

Merci d’avance pour votre collaboration. Je vais tenter de décortiquer et de comprendre vos interventions et suggestions afin de progresser.

Le fichier est posté à l'adresse suivante :

Free - Envoyez vos documents

Le long chemin vers la connaissance commence toujours par un petit pas !

Philouis

 

[jp14]

Re : userform en chantier

Bonsoir

Une première réponse, pour imposer une saisie numérique avec des décimales

Private Sub FC_COTISATION_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Static virgule As Boolean
If FC_COTISATION.SelStart = 0 Then virgule = False ' pour initialiser la variable virgule
    Select Case KeyAscii
    Case 46
        If virgule = False Then
            KeyAscii = 44
            virgule = True
        Else
            KeyAscii = 0
        End If
    Case Is < 48, Is > 57
        KeyAscii = 0
    End Select
    
End Sub

Un usf pour sélectionner la personne et transfert des données.

Macro à mettre dans un module et avec le bouton droit de la souris affecter cette macro au bouton

A tester

JP

 

[philouis]

Re : userform en chantier

Bonjour jp14,

j'ai testé ta proposition mais hélas ça ne fonctione pas chez moi !

mais peut-être n'ai je pas inséré le code au bon endroit ?

voilà ce que j'ai fait :

Private Sub FC_COTISATION_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

FC_COTISATION.Value = Replace(FC_COTISATION.Value, ".", ",")
If Not IsNumeric(FC_COTISATION.Value) Then
FC_COTISATION.Value = ""
Else
FC_COTISATION.Value = Format(FC_COTISATION.Value, "0.00")
End If

End Sub
Private Sub FC_COTISATION_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 46
KeyAscii = 44
Case Is < 48, Is > 57
KeyAscii = 0
End Select

End Sub

Philouis

 

[jp14]

Re : userform en chantier

Bonsoir

Bonjour jp14,

j'ai testé ta proposition mais hélas ça ne fonctione pas chez moi !

Philouis

Pour voir l'effet la procédure il faut commettre des erreurs
Il faut taper des lettres et un point.

Ps j'ai rajouté un usf
JP

 

[philouis]

Re : userform en chantier

jp14,

Merci pour ton intervention.

J'ai un problème :
impossible d' ouvrir ton fichier nommé selecvaleur2.zip

comment faire ?

Philouis

 

[noviceAG]

Re : userform en chantier

Bonsoir à tous, le Forum,
Voici ce que j'ai pu obtenir :

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} selecvaleur2
Caption = "UserForm3"
ClientHeight = 2970
ClientLeft = 45
ClientTop = 435
ClientWidth = 6600
OleObjectBlob = "selecvaleur2.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "selecvaleur2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim nomfeuille1 As String
Dim lig As Long

Private Sub TextBox2_Change()

End Sub

'--------------------------------------------
' Module : selecvaleur/UserForm_QueryClose
' Utilisation as la croix rouge
'--------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Private Sub CommandButton1_Click()

If ComboBox1.Value = "" Then
Call MsgBox("Vous devez sélectionner une valeur", vbCritical, Application.Name)
ComboBox1.SetFocus
Exit Sub
End If

If Not IsDate(TextBox2.Value) Then
Call MsgBox("Vous devez entrer une date" _
& vbCrLf & "jj/mm/aaaa" _
, vbCritical, Application.Name)
TextBox2.Value = ""
TextBox2.SetFocus
Exit Sub
End If

lig = CLng(ComboBox1.List(ComboBox1.ListIndex, ComboBox1.ColumnCount - 1))
Select Case MsgBox("Les données de :" _
& vbCrLf & "nom :" & ComboBox1.Value _
& vbCrLf & "Prénom :" & ComboBox1.List(ComboBox1.ListIndex, 2) _
& vbCrLf & "Ligne :" & lig _
& vbCrLf & "vont être supprimés" _
& vbCrLf & "" _
& vbCrLf & "Etes vous d'accord" _
& vbCrLf & "" _
, vbYesNo Or vbExclamation Or vbDefaultButton1, Application.Name)

Case vbYes
Call ajoutlig("BASE RESILIES", "a", "BASE ACTIFS", lig)
Case vbNo
Exit Sub
End Select

End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
ComboBox1.Visible = True
Label2.Visible = True
Me.Caption = "Selectionner une personne"
Call remplircomboaveccond

'selecvaleur2.Caption = message
End Sub
Sub remplircomboaveccond()
'Déclare un tableau à 2 dimensions.
Dim £Tableau() As String

Dim £cellule As Range
Dim £i As Long, £j As Integer, £y As Integer
Dim £numColTri As Byte 'numéro de la colonne à trier
Dim £nbCol As Byte ' nombre de colonne
Dim £t As Variant
'Dim £Resultat As String
£nbCol = 3
nomfeuille1 = "BASE ACTIFS"
£i = Sheets(nomfeuille1).Range("a65536").End(xlUp).Row + 2 ' taille du tableau
'Dim £Tableau(1 To 4, 1 To 4, 1 To 4, 1 To 4) As String
ReDim £Tableau(1 To £i, 1 To £nbCol)
'Remplir le tableau
£i = 1
For Each £cellule In Sheets(nomfeuille1).Range("a3:a" & Sheets(nomfeuille1).Range("b65536").End(xlUp).Row)

£Tableau(£i, 1) = £cellule.Value
£Tableau(£i, 2) = £cellule.Offset(0, 1).Value
£Tableau(£i, 3) = £cellule.Row
£i = £i + 1

Next £cellule
' trier le tableau
£numColTri = 1 'colonne à trier

For £i = 1 To UBound(£Tableau, £numColTri)
For £j = 1 To UBound(£Tableau, £numColTri)
If £Tableau(£j, £numColTri) > £Tableau(£i, £numColTri) Then

For £y = 1 To £nbCol
£t = £Tableau(£i, £y)
£Tableau(£i, £y) = £Tableau(£j, £y)
£Tableau(£j, £y) = £t
Next £y

End If
Next £j
Next £i

With ComboBox1

.Clear
.ColumnCount = £nbCol
.ColumnWidths = "80;60;0"
.Style = fmStyleDropDownList '
.BoundColumn = 1 ' combobox1.text contient le nom
For £i = 1 To UBound(£Tableau, £numColTri)
If £Tableau(£i, 1) <> "" Then
.AddItem £Tableau(£i, 1)
.List(.ListCount - 1, 1) = £Tableau(£i, 2)
.List(.ListCount - 1, 2) = £Tableau(£i, 3)
End If
Next £i



End With

End Sub

Private Sub ajoutlig(£nomdest As String, £col As String, £nomorigine As String, £ligacop As Long)
' call ajoutlig( "feuille destination", "colonne pour trouver la dernière ligne", "feuille origine", "ligne à copier")
With Sheets(£nomdest)


Sheets(£nomorigine).Rows(£ligacop).Copy _
Destination:=.Rows(.Range(£col & "65536").End(xlUp).Row + 1)
Sheets(£nomorigine).Rows(£ligacop).Delete Shift:=xlUp
End With
End Sub

 

[jp14]

Re : userform en chantier

Bonjour

L'éditeur vba propose dans son menu "fichier" : l'importation et l'exportation de fichier, et la fonction "supprimer un module".

La fonction exportation donne pour :

un module : on obtient un fichier avec l'attribut .bas fichier qui peut lu par un éditeur de texte, ce qui permet de faire copier coller.

un userform : on obtient deux fichiers .frm, .frx le fichier avec l'extension. frx est illisible, le .frm est un fichier de type texte avec au niveau des premières lignes des information pour l'userform.
Le reste du texte correspond aux macros.

un module de classes : on obtient un fichier .cls.

Pour récupérer ces fichiers il suffit d'utiliser la fonction importation.

Pour faire une copie d'un userform il suffit de le sauvegarder, de renommer l'userform puis d'importer le fichier.

JP