1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

XL 2003 Besoin codes pour Usf

Discussion dans 'Forum Excel' démarrée par castor30, 10 Juillet 2017.

  1. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    Bonjour

    les entetes de lignes ont été supprimées pendant mes tests. je n'avais pas fait attention
    tu peux faire un copier coller à partir de la feuille "Base Init" de sauvegarde..
     
  2. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    Bonjour vgendron,
    OK, rien d'important, je pensais que tu utilisais ceci pour tes codes.
    J'espère que tu as passé un bon Week-end !
     
  3. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    Bonjour vgendron,
    Toujours un bug ici :
    Sub AgeUpdate()
    If Me.Controls("tb3") <> "" Then
    Me.TbAge = DateDiff("yyyy", Me.Controls("tb3"), Now)
    Else
    Me.TbAge = ""
    End If
    End Sub
     
  4. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    Ne me laisse pas tomber vgendron, merci à toi.
     
  5. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    hello
    J'imagine que ca bug lorsque tu souhaites modifier la date de naissance
    change le code de la macro AgeUpdate par celui ci
    Code (Visual Basic):

    Sub AgeUpdate()
    If Me.Controls("tb3") <> "" And (Len(Me.Controls("tb3")) = 10) Then
        Me.TbAge = DateDiff("yyyy", Me.Controls("tb3"), Now)
    Else
        Me.TbAge = ""
    End If
    End Sub
     
     
    castor30 aime votre message.
  6. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    Bonjour vgendron,
    Je te remercie pour la modification ça marche.
    Par contre, je n'arrive plus à me positionner sur le tb5...
    La macro qui inscrit "Non communiquée" ne se lance pas
     

    Pièces jointes:

  7. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    4369
    "J'aime" reçus :
    60
    Sexe :
    Masculin
    Habite à:
    Savigny le Temple 77176
    Utilise:
    Excel 2010 (PC)
    Bonjour castor
    Bonjour Le Fil (vgendron), le Forum
    voila ce que je me suis permis de mettre pour ce qui concerne le Tb3
    Code (Visual Basic):
    Private Sub tb3_Change()
    If Len(Me.tb3) = 10 And Me.tb3 <> "" Then
    Me.TbAge = DateDiff("yyyy", CDate(Me.Controls("tb3")), Date)
    Else
    Me.TbAge = ""
    End If
    End Sub
    Code (Visual Basic):
    Private Sub tb3_KeyPress(ByVal Touche As MSForms.ReturnInteger)
    If InStr("0123456789/", Chr(Touche)) = 0 Then Touche = 0
    End Sub
    ce qui interdit de saisir n'importe quoi comme date de naissance ! Lol
    même si ça ne règle pas tout Lol
    Bonne journée
    Amicalement
    Jean marie[/Code]
     
    Dernière édition: 20 Juillet 2017
    castor30 aime votre message.
  8. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    4369
    "J'aime" reçus :
    60
    Sexe :
    Masculin
    Habite à:
    Savigny le Temple 77176
    Utilise:
    Excel 2010 (PC)
    Re
    j'ai amélioré le Système (mais perfectible ) Lol
    Bonne fin de Journée
    Amicalement
    Jean marie
     

    Pièces jointes:

  9. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    Hello Czac

    euh.. t'es sur que ta fonction "vérifier" a déjà fonctionné?
    avec cette ligne de code.. y a peu de chance que ca marche...

    If Cells(Lig, 10) = "" And Cells(Lig, 10) <> "" Then

    cette macro est censée vérifier quoi?

    Hello Chti.. très bien le controle de saisie. j'avoue y avoir pensé. mais ne savais pas comment le faire :)

    Czac.. dans ta macro de vérification
    tu fais référence à Feuil3
    sauf que Feuil 3, c'est la feuille Base INIT
    il faut travailler sur la feuille Base..
    donc remplacer
    Code (Visual Basic):

    Sub Vérifier()       'OK
        Dim DerL&, Lig&
        DerL = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row
        For Lig = 2 To DerL
            If Cells(Lig, 10) = "" And Cells(Lig, 10) <> "" Then 'test à revoir......
                With Cells(Lig, 12)
                    .Value = "Non communiquée" 'on écrit dans la colone K ???
                    .Font.Bold = True
                    .Font.ColorIndex = 3
                End With
            Else
         End If
        Next Lig
        Cells.Columns.AutoFit
        Range("A1").Select
    End Sub
     
    et dernière chose.. à quel moment cette macro est appelée?
     
    Dernière édition: 20 Juillet 2017
    castor30 aime votre message.
  10. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    Bonjour ChTi160,vgendron,
    ChTi160 as-tu vérifier le fichier ?
    vgendron j'appelle cette macro à la fin de : Private Sub B_valid_Click()
    et je n'arrive plus à me positionner sur le tb5
     
  11. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    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...
     
  12. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    Voici le fichier.
    Question dans le tb3 (date) peut-on saisir 3/04/55 ou 03/04/1955
    Je te remercie.
     

    Pièces jointes:

  13. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    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
     
  14. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    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.
    Code (Visual Basic):
    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
     
    Dernière édition: 21 Juillet 2017
  15. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    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
     
  16. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    3572
    "J'aime" reçus :
    205
    Utilise:
    Excel 2007 (PC)
    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.
     

    Pièces jointes:

    castor30 aime votre message.
  17. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    4369
    "J'aime" reçus :
    60
    Sexe :
    Masculin
    Habite à:
    Savigny le Temple 77176
    Utilise:
    Excel 2010 (PC)
    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
    Code (Visual Basic):
    Private Sub tb12_Change()
    Dim Valeur As Byte
    tb12.MaxLength = 5 'nb caracteres maxi dans textbox
    End Sub
    Code (Visual Basic):
    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 et vgendron aiment cela.
  18. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    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 :

    Code (Visual Basic):
    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.
     

    Pièces jointes:

  19. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    4369
    "J'aime" reçus :
    60
    Sexe :
    Masculin
    Habite à:
    Savigny le Temple 77176
    Utilise:
    Excel 2010 (PC)
    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" :
    Code (Visual Basic):
    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
     
    Dernière édition: 22 Juillet 2017 à 19:49
  20. castor30

    castor30 XLDnaute Occasionnel

    Inscrit depuis le :
    12 Décembre 2014
    Messages :
    144
    "J'aime" reçus :
    0
    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.
     

Partager cette page