Formulaire Excel

Bonjour à tout le forum

Voilà Je cherche quelqu'un qui pourrais me faire marcher le formulaire que je mets sur le site

et je suis preneur d'idées autre

Je voudrais que les quatres boutons fonctionnent Que les cases vertes se remplissent toutes seules car il y a des opérations dans la feuil BD Col. N P Q R S T U qui correspondent aux cases verte du Formulaire, et je voudrais Que la cases Emis par soit remplis par la case BD Col. N si c'est le même nom que la personne qui s'inscrit

Merci d'avance

Bonjour Bidouille,

Tu crées un formulaire sous excel avec des cases, à priori pourquoi pas pour ajouter.

Mais pour aller à avant de modifier ou supprimer, tu ne peux pas faire défiler tous tes enregistrements en haut du formulaire excel.

Il faut que tu remplisses un vrai formulaire comme celui-là, sous userform dans le développeur VB.

en suivant la vidéo

a+

Fronck

Bonjour fronck , Bonjour Bidouille,

Je suis un inconditionnel du formulaire sur onglet, plus simple en mise en place.

Voici un exemple génétique ...

Toutes les zones de saisie comportent un nom du type _colXX où XX est la colonne du tableau de données.

Il n'y a que les 3 constantes de la macro à mettre jour si nécessaire.

Tout se déroule en "transparence".

Tape par exemple 1 ou 2 comme identifiant dans la zone jaune.

Option Explicit
Const prefixe = "_col" ' le nom de la zone doit être suivi du n° de colonne dans la base de données, exemple _col21
Const BdD = "BD" ' onglet où se trouve la base de données
Const ID = "ID" ' nom donné au champ clé dans le formulaire, en colonne A de la BdD obligatoirement

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nom As Name, colonne As Long, ligne As Long
    Application.EnableEvents = False
    On Error GoTo fin
    With Sheets(BdD)
        ligne = lig(True)
        Application.StatusBar = ""
        If Not Intersect(Target, Range(ID)) Is Nothing Then
            If ligne = 0 Then
                If MsgBox("Etes-vous certain de vouloir ajouter le Code """ & Range(ID).Value & """ inconnu ?", vbYesNo, "Demande de confirmation") = vbYes Then
                    ajouter Range(ID).Value
                    ligne = lig(True)
                    renseigner True
                    MsgBox "Code """ & Range(ID).Value & """ ajouté !"
                Else
                    Application.Undo
                End If
            Else
                renseigner True
            End If
        ElseIf lenom(Target) Like prefixe & "*" Then
            .Cells(ligne, col(lenom(Target))) = Target.Cells(1).Value
            Application.StatusBar = "Mise à jour pour " & Range(ID).Value & " ok :: " & Target.Cells(1).Value
        End If
    End With
    Application.EnableEvents = True
    Exit Sub
fin:
    MsgBox "Erreur n° " & Err.Number & vbLf & Err.Description
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Activate()
    Application.EnableEvents = False
    Application.StatusBar = ""
    On Error GoTo fin
    If lig(True) = 0 Then
        Range(ID).Value = "" ' le code a été supprimé - on efface tout !
        renseigner False
    Else
        renseigner True
    End If
    Application.EnableEvents = True
    Exit Sub
fin:
    MsgBox "Erreur n° " & Err.Number & vbLf & Err.Description
    Application.EnableEvents = True
End Sub

Private Function lenom(cel As Range) As String
' donne le nom affecté à la zone éventuellement fusionnée ou à défaut son adresse
    lenom = cel.Address
    On Error Resume Next
    lenom = cel.Cells(1).Name.Name
End Function

Private Function col(chaine As String) As Long
' donne le numéro de colonne issu du nom de la zone
    col = Val(Mid(chaine, Len(prefixe) + 1, Len(chaine) - Len(prefixe)))
End Function

Private Function lig(ok As Boolean) As Long
' donne la ligne où se trouve l'ID dans BD, 0 si pas trouvé !
Dim trouve As Range
    lig = 0
    Set trouve = Sheets(BdD).Columns("A").Find(what:=Range(ID).Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not trouve Is Nothing Then lig = trouve.Row
End Function

Private Sub renseigner(ok As Boolean)
' ok false = effacer, true = remplir
Dim nom As Name
    For Each nom In ThisWorkbook.Names
        If nom.Name Like prefixe & "*" Then
            If ok Then
                Range(nom.Name).Value = Sheets(BdD).Cells(lig(True), col(nom.Name))
            Else
                Range(nom.Name).Value = ""
            End If
        End If
    Next
End Sub

Private Sub ajouter(cetID As Variant)
    Sheets(BdD).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = cetID
End Sub

Bonjour à tous Fronck et Steelson

Je vous remercie de vous interresser à mon idée

car ce n'ai pas un problème

je suis positif.

Mais j'aurais préferer de partir de mon dossier si il etais possible de me faire le code sur mon dossier ce serais super

[size=150]

merci beaucoup[/size]

Un bout d'essai, mais il faudra ensuite ajouter tes formules de calcul.

Excellent les deux exemples jean Aymar et jean Peuplus, moi j'aurais même mis j'en peu plus en premier.

Merci Beaucoup

Gerard menvussa

Merci!!! je vois çà demain est je vous tiens au courant

Bonjour à tous

Merci à Steelson c'est super ce que tu m'a envoyer Génial etc...

Il manque la suppression qui n'existe pas (je trouve cela trop sensible, je l'ai laissé manuellement dans l'onglet base de données).

Tu peux aussi redisposer les plages autrement en les faisant glisser dans la feuille pour leur conserver leur nom en _colXX, colorier, mettre des listes déroulantes, mettre des formats, etc. tout est plus simple à mettre ne place qu'avec un userform.

Bonjour à tous et à Steelson

Super, mais il y a toujours un mais

Je n'ai pas réussi à faire marche Total Groupe,Groupe + ou - 80 Pers.et Date

Je les ai mis en rouge

Car il me manque des _col

J'ai 16 _col je croyais quand agrandissant le tableau ça irai et ben non je ni arrive pas alors je cris au secour

Je joint le dossier

Merci de m'aider

Bidouille a écrit :

Je n'ai pas réussi à faire marche

Total Groupe,

Groupe + ou - 80 Pers.

Date

Peux-tu me réexpliquer à quoi cela correspond et comment tu les calcules ?