Besoin codes pour Usf

castor30 · 10 Juillet 2017

Bonjour à vous tous,
Je viens vous demander si pour l'un d'entre vous, ce ne serait pas trop demander que de codifier l'Userform que j'ai réussi à faire, mais pour ce qui est de coder en Vba mes connaissances en ce domaine sont nulles.
Recevez dès à présent toute ma reconnaissance.

vgendron · 20 Juillet 2017

Comme tu ne réponds pas vraiment aux questions, que tu dis que tu appelles la macro la fin de Private sub...
je me demande si on travaille sur le meme fichier
--> poste la dernière version de ton fichier que tu utilises

et quand je te dis que cette ligne a peu de chance de fonctionner
If Cells(Lig, 10) = "" And Cells(Lig, 10) <> "" Then

en francais ca donne..
si la cellule est vide ET qu'elle n'est pas vide......
ca ne PEUT PAS fonctionner.. c'est l'un OU l'autre. pas les deux à la fois..
à moins que ce soit une cellule de schrodinger...

castor30 · 20 Juillet 2017

Voici le fichier.
Question dans le tb3 (date) peut-on saisir 3/04/55 ou 03/04/1955
Je te remercie.

vgendron · 20 Juillet 2017

bon.. avant de poser des questions.. réponds à celles qu'on te pose !!
pourquoi ton Tb5 est il passé à enable = false ?
pourquoi la modif de CHTI n'apparait pas dans ton fichier?

il faut chercher un minimum de ton coté et ne pas te contenter d'attendre une solution clé en mains !
pour moi. c'est tout pour ce soir

castor30 · 21 Juillet 2017

Dois-je remplacer :
Private Sub tb3_Change()
AgeUpdate
End Sub
par les deux macros de ChTi160 ?

La macro Vérifier m'a été donné il y a plusieurs mois par un membre de ce forum, mais à ce moment je ne notais pas les liens. Et ce code fonctionne chez moi.

VB:

Sub Vérifier()
    Dim DerL&, Lig&
    DerL = Feuil2("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To DerL
        If Cells(Lig, 12) = "" And Cells(Lig, 10) <> "" Then
            With Cells(Lig, 12)
                .Value = "Non communiqué"
                .Font.Bold = True
                .Font.ColorIndex = 3
            End With
        Else
            With Cells(Lig, 12)
                .Value = .Value
                .Font.Bold = False
                .Font.ColorIndex = 1
            End With
        End If
        If Cells(Lig, 10) = "" And Cells(Lig, 12) <> "" Then
            With Cells(Lig, 10)
                .Value = "Non communiquée"
                .Font.Bold = True
                .Font.ColorIndex = 3
            End With
        Else
            With Cells(Lig, 10)
                .Value = .Value
                .Font.Bold = False
                .Font.ColorIndex = 1
            End With
        End If
    Next Lig
    Cells.Columns.AutoFit
    [A1].Select
End Sub

vgendron · 21 Juillet 2017

Salut
Ton TB5 est passé de enable à disable entre le post 19 et post 20
la version 4 que j'ai envoyée en post19 permet bien de sélectionner le TB5
la version 4 bis que TU as envoyée en post20, ne le permet plus.. --->pourquoi as tu modifié si ce n'est pas ce que tu souhaites?

les macros de chti étaient déjà dans le fichier qu'il a envoyé... l'as tu au moins essayé??

et je ne retrouve plus mes modifs...
je refais une version qui inclue tout. mais c'est la dernière fois

vgendron · 21 Juillet 2017

Voici une Rev 10 qui reprend TOUTES les modifs - les miennes, celles de CHTI pour le controle de saisie de la date de naissance, et j'ai réutilisé le meme principe pour la saisie des numéros de téléphone.

ChTi160 · 21 Juillet 2017

Bonjour castor30
Bonjour Le Fil (vgendron),Le Forum
Histoire de te faire râler (vgendron)Lol
j'ai modifiée la dernière version qui ne le sera plus ! Lol
Ainsi pour ce qui est de la saisie du CP

VB:

Private Sub tb12_Change()
Dim Valeur As Byte
tb12.MaxLength = 5 'nb caracteres maxi dans textbox
End Sub

VB:

Private Sub tb12_KeyPress(ByVal Touche As MSForms.ReturnInteger)
If InStr("0123456789", Chr(Touche)) = 0 Then Touche = 0 'si on tape autre chose qu'un chiffre, il est annulé
End Sub

je regarde ce beau travail !
Bonne journée
Amicalement
Jean marie

castor30 · 22 Juillet 2017

Bonjour vgendron, ChTi160,
Je vous remercie infiniment pour votre implication pour ce travail qui me tenait à cœur malgré mes connaissances proches de zéro. Vraiment, je vous remercie encore très chaleureusement, car vous donnez le meilleur de vous-même avec désintéressement, et bénévolement.
Je mets ci-après le code modifié de la Sub Vérifier qui fonctionne :

VB:

Sub Vérifier()     'vérifie qu'il y a une adresse
    Dim DerL&, Lig&
    DerL = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To DerL
        If Cells(Lig, 10) = "" Then
                With Cells(Lig, 10)
                .Value = "Non communiquée"    'si absence adresse
                .Font.Bold = True
                .Font.ColorIndex = 3
                End With
            Else
         End If
    Next Lig
    Cells.Columns.AutoFit
    [A1].Select
End Sub

Je vais faire encore divers essais avant de clôturer le sujet.
Je joint le fichier au cas ou il intéresserait quelqu'un.
En vous remerciant encore.

ChTi160 · 22 Juillet 2017

Bonsoir castor30
Bonsoir Le Fil ,Le Forum
j 'ai pensé adapter la Procédure "CreerContact" afin de supprimer les procédures Vérifier et Tiret
j 'ai modifié ainsi a procédure "CreerContact" :

VB:

Option Explicit
Dim C
Dim i As Byte
Dim FinBase As Long
Sub CreerContact()
With Usf_Action
    If .Controls("Tb2").Value = "" Then
        MsgBox ("Veuillez saisir un prénom avant de continuer")
        Exit Sub
    End If
End With
    With Sheets("Base")
        Set C = .Range("A:A").Find(Usf_Action.tb1, Lookat:=xlWhole)
        If Not C Is Nothing Then
            MsgBox ("Attention ! Ce Nom existe déjà")
            Exit Sub
        Else
            FinBase = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            For i = 1 To 21
              With .Range("A" & FinBase).Offset(0, i - 1)
                      
                         .Value = IIf(Usf_Action.Controls("Tb" & i) = "", IIf(i > 5 And i < 10, "-", ""), _
                                               Usf_Action.Controls("Tb" & i)) ' On met "-" selon colonne Vide
                    If .Value = "-" Then .HorizontalAlignment = xlCenter 'Si "-"  On centre
                Select Case i 'un peu de mise en forme
                    Case 1 'Majuscule et gras
                          .Value = UCase(.Value) 'mise en majuscule du NOM
                          .Font.Bold = True 'mise en Gras du NOM                 
                    Case 2, 4, 11, 13, 14, 15, 16, 17  '1° lettre des mots en Majuscule
                          .Font.Bold = True
                          .Value = WorksheetFunction.Proper(.Value)
                    Case 3
                          .Value = Format(.Value, "dd/mm/yyyy")
                    Case 6, 7, 8
                          .Value = Format(.Value, "0# ## ## ## ##")
                    Case 9
                        'format adresse mail ?
                         .Value = .Value
                    Case 10
                         .Value = IIf(.Value = "", "Non communiquée", .Value) 'Si vide "Non communiquée"
                         .Value = WorksheetFunction.Proper(.Value) 'On formate
                         .Font.Bold = True
                         .Font.ColorIndex = 3
                    Case 12
                         .Value = IIf(.Value = "", "Non communiqué", Format(.Value, "#####"))'Si vide "Non                                               communiqué"
                         .Font.Bold = True
                         .Font.ColorIndex = 3
                End Select
             End With
            Next i
                         'mise à jour de la date de MàJ en colonne V
                         .Range("A" & FinBase).Offset(0, 21) = Format(Now, "dd/mm/yyyy")
            'ChargerData
        End If
            .Cells.Columns.AutoFit 'On ajuste la largeur des Colonnes
    End With
    Usf_Action.B_valid.Caption = "Modifier"
End Sub

Voir si utile ! lol
Bonne fin de Soirée
Amicalement
Jean marie

castor30 · 23 Juillet 2017

Bonjour ChTi160,
Je te remercie de ton implication et pour le code fourni.
Il y a cependant une petite erreur.
En effet, il faudrait que ça mette un tiret dans les colonnes F:I et K:M
La mention "Non Communiquée" uniquement dans la colonne J
En te remerciant vivement.

ChTi160 · 23 Juillet 2017

Re
Ok je regarde cela ! Lol
lorsque tu mets "F:I"
ça concerne quelles Colonne F,G,H,I ou F et I
Bonne fin de Journée
Amicalement
Jean marie

ChTi160 · 23 Juillet 2017

Re
le fichier modifié
à Voir réponses : aux questions non encore reçues . voir procédure "CreerContact"
Bonne fin de Soirée
Amicalement
Jean marie

castor30 · 23 Juillet 2017

Re,
Oui, ça concerne les colonnes "F:I" =F,G;H et I ainsi que "K:M" = K, L et M
On met un tiret si rien n'a été saisi dans les Textbox.
Idem pour Non communiquée

Réponses aux questions :
pourquoi ton Tb5 est il passé à enable = false ?
J'ai du faire une fausse manip avec la souris.

pourquoi la modif de CHTI n'apparait pas dans ton fichier?
Elle n'étais pas encore intégrer dans le fichier.

il faut chercher un minimum de ton coté et ne pas te contenter d'attendre une solution clé en mains !
C'est ce que je fais, mais ce n'est pas évident lorsque l'on débute.

Tous mes remerciement chaleureux.

ChTi160 · 23 Juillet 2017

Re
OK !
Donc le fichier répond à la demande ,tu regardes et me dis !
Bonne fin de Soirée
Amicalement
Jean marie

castor30 · 23 Juillet 2017

RE,
Merci beaucoup ChTi160.
J'avais gardé en archives ce codes issu d'un fichier que j'avais vu voici quelque temps.
Peut-il servir dans mon cas ...?

VB:

Private Sub Texbox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim adm$, i%, j%, nc As Boolean
    adm = Trim(tb6.Value)
    If adm = "" Then Exit Sub
    adm = Replace(Replace(Replace(adm, "..", "."), "--", "-"), "__", "_")
    adm = Replace(Replace(Replace(adm, ".@", "@"), "-@", "@"), "_@", "@")
    adm = Replace(Replace(Replace(adm, "@.", "@"), "@-", "@"), "@_", "@")
    If adm Like "@*" Then adm = Right(adm, Len(adm) - 1)
    If adm Like "*@" Then adm = Left(adm, Len(adm) - 1)
    For i = 1 To Len(adm)
        If Mid(adm, i, 1) = "@" Then j = j + 1
    Next i
    If j = 1 Then
        i = InStr(Split(adm, "@")(1), ".")
        If i > 0 Then
            For i = 1 To Len(adm)
                Select Case Asc(Mid(adm, i, 1))
                    Case 45, 46, 48 To 57, 64 To 90, 95, 97 To 122
                    Case Else
                        nc = True: Exit For
                End Select
            Next i
        Else
            nc = True
        End If
    Else
        nc = True
    End If
    If nc Then
        MsgBox "L'adresse mail n'est pas conforme !", vbInformation, "Adresse invalide"
        Cancel = True
    Else
        tb6.Value = adm
    End If
End Sub

Mais peut-être est-ce inutile...?

Besoin codes pour Usf

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Partager cette page

Statistiques des forums