Problème de saisie entre deux formulaires

Le 16/08/2022 à 23:58

Bonsoir à tous

Je vous expose mon souci, j'ai un problème de date dans deux formulaires. Avec le formulaire FrmSaisie j'obtiens le format que je veux.

Lorsque j'utilise le formulaire database pour modifier une, le format date n'est plus le même

pouvez vous m'expliquer, je cherche je cherche mais le ne trouve pas la solution

14cimetiereweb.xlsm (48.61 Ko)
Le 17/08/2022 à 01:00

Bonjour micîd,

'''Database
Me.Txt_Date_debut = Me.ListBox1.Column(9, ligne)
Me.Txt_Date_debut = CDate(Me.Txt_Date_debut)
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 10) = Me.Txt_Date_debut

'''frmSaisie
ActiveCell.Offset(0, 8).Value = Txt_date_achat

Voici la différence ... dans "Database" ... le Txt_Date_debut est alimenté via le listbox ...

Puis ... tu utilise CDate sur le Txt_date_debut ...

Essai avec l'une ou l'autre de tes méthodes ... voir celle qui convient ...

Tu peux retrouver rapidement les occurrences à l'aide de la recherche CTRL+F  ...

ric

Le 17/08/2022 à 08:22

Voila ce que j'ai mis le code du bouton modifier du formulaire datebase mais je dois me tromper

Private Sub Btn_modifier_Click()
If Me.Txt_nr_concession = "" Then
MsgBox ("Il manque le numéro de concession !")
Else
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 2) = Me.Txt_nr_concession
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 3) = Me.Txt_section
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 4) = Me.Txt_rang
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 6) = Me.txt_libre_concede
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 7) = Me.Txt_type_concession
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 8) = Me.Txt_famille
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 9) = Me.Txt_concessionActuel

'''Database

Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 10) = Me.Txt_Date_debut

Me.Txt_Date_debut = Me.ListBox1.Column(9, ligne)
Me.Txt_Date_debut = CDate(Me.Txt_Date_debut)

'Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 10) = Me.Txt_Date_debut
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 11) = Me.Txt_duree
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 13) = Me.Txt_adresse
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 14) = Me.Txt_telephone
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 15) = Me.Txt_mail
Sheets("source").ListObjects(1).DataBodyRange(Me.Txt_RowId, 16) = Me.Txt_observation

Me.Txt_nr_concession = ""
Me.Txt_section = ""
Me.Txt_rang = ""
Me.txt_libre_concede = ""
Me.Txt_type_concession = ""
Me.Txt_famille = ""
Me.Txt_concessionActuel = ""
Me.Txt_Date_debut = ""
Me.Txt_duree = ""
Me.Txt_adresse = ""
Me.Txt_telephone = ""
Me.Txt_mail = ""
Me.Txt_observation = ""
Me.Txt_RowId = ""

'relancer le recherche pour afficher les modification

  Sheets("source").Range("z3") = "*" & Me.Txt_chercher & "*"
  Range("T_source").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("source").Range("Z2:Z3"), CopyToRange:=Sheets("source").Range("AB2:AR2"), Unique:=False
  Me.ListBox1.RowSource = "decaler"

End If

End Sub

En fait la date de la feuille "source" (colonne K date de début) doit être au format texte pour pouvoir calculer une date de fin feuille "source" colonne M sachant que les dates de début peuvent être avant 1900

Encore merci pour votre réaction

Le 19/08/2022 à 08:08

Personne pour m'aider ?

Le 19/08/2022 à 11:31

Bonjour,

ci-dessous code

Private Sub Btn_modifier_Click()
    Dim i As Integer, j As Integer
    Dim ctrl As Control

    If Me.Txt_nr_concession = "" Then
        MsgBox ("Il manque le numéro de concession !")
    Else
        With [T_source].ListObject
            i = .ListColumns("ID").Range.Find(Val(Me.Txt_RowId), LookIn:=xlValues, LookAt:=xlWhole).Row 'indice ligne feuille
            j = i - .HeaderRowRange.Row  'indice ligne tableau structuré

            .ListColumns("N° Concession").DataBodyRange(j) = Me.Txt_nr_concession
            .ListColumns("Section").DataBodyRange(j) = Me.Txt_section
            .ListColumns("Rang").DataBodyRange(j) = Me.Txt_rang
            .ListColumns("Libre ou Concédé").DataBodyRange(j) = Me.txt_libre_concede
            .ListColumns("Type de Concession").DataBodyRange(j) = Me.Txt_type_concession
            .ListColumns("Famille").DataBodyRange(j) = Me.Txt_famille
            .ListColumns("Concession actuelle").DataBodyRange(j) = Me.Txt_concessionActuel
            .ListColumns("Date de Début").DataBodyRange(j) = CDate(Me.Txt_Date_debut)
            .ListColumns("Durée").DataBodyRange(j) = CDec(Me.Txt_duree)
            .ListColumns("Adresse du concessionnaire actuel").DataBodyRange(j) = Me.Txt_adresse
            .ListColumns("Téléphone").DataBodyRange(j) = Me.Txt_telephone
            .ListColumns("Mail").DataBodyRange(j) = Me.Txt_mail
            .ListColumns("Observations").DataBodyRange(j) = Me.Txt_observation
        End With

        For Each ctrl In Me.Controls
            If TypeOf ctrl Is MSForms.TextBox Then ctrl = ""
        Next ctrl

        'relancer le recherche pour afficher les modifiction

        Sheets("source").Range("z3") = "*" & Me.Txt_chercher & "*"
        Range("T_source").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("source").Range("Z2:Z3"), CopyToRange:=Sheets("source").Range("AB2:AR2"), Unique:=False
        Me.ListBox1.RowSource = "decaler"

    End If

End Sub
Rechercher des sujets similaires à "probleme saisie entre deux formulaires"