Correction de Codes d'un formulaire de saisie Uerform

Webperegrino · 16 Août 2009

Bonjour,
Je débute dans le VBA, Codes, Formulaire de saisie dans une base de données.
J'en appelle à la pédagogie et la précision de spécialistes dans ce domaine pour m'aider à corriger et mettre en place les codes selon la liste ci-jiointe.

En page 1 : mon formulaire de saisies, ses fenêtres, les relations de codes dans VBa, leurs positionnements souhaités dans la base BD.

En page 2 : le résultat de mon fastidieux travail de mise en place de la codification. Deux mois de recherche, d'erreurs cumulées et à chaque fois des messages d'erreurs...

En plus, mes six déroulants de formulaire ne me donnent même pas le contenu préparé dans la base, en feuille 'paramètres' ! le codification m'est encore totalement inconnue.

Merci de m'aider à mettre tout cela "en ordre". Pour l'ordre j'a fait de mon mieux.
Mon but : y voir plus clair, repartir sur de nouvelles bases pour mieux comprendre ce langage VBA qui ne m'est pas commun encore dans Excel.
Webperegrino

Robert · 21 Août 2009

Re : Correction de Codes d'un formulaire de saisie Uerform

Bonjour Webperegrino, bonjour le forum,

Oui je dis souvent que je n'ai trouvé aucun jeux plus passionnant que de programmer et d'arriver à obtenir ce que l'on désire...

Voilà ce que pourrait être la macro du bouton valider qui place les données et vide la calculette :

Code:

Sub valider()
Dim dest As Range 'déclare la variable dest (DESTination)
 
Set dest = Sheets("BD").Range("A65536").End(xlUp).Offset(1, 0) 'de'finit la variable dest
 
'envoie des données dans la base et réinitialisation de la calculette
With Sheets("Solution SAISIE en MULTIPLE")
    If .Range("D4").Value <> 0 Then
        dest.Value = .Range("D4").Value 'date
        .Range("D4").Value = ""
    End If
    If .Range("D6").Value <> 0 Then
        dest.Offset(0, 2).Value = .Range("D6").Value 'lieu
        .Range("D6").Value = ""
    End If
    If .Range("D24").Value <> 0 Then
        dest.Offset(0, 5).Value = .Range("D24").Value 'cumul gratuits
        .Range("D24").Value = ""
    End If
    If .Range("D28").Value <> 0 Then
        dest.Offset(0, 6).Value = .Range("D28").Value 'sacs vidés gratuits
        .Range("D28").Value = ""
    End If
    If .Range("F24").Value <> 0 Then
        dest.Offset(0, 7).Value = .Range("F24").Value 'cumul 0,5 €
        .Range("F24").Value = ""
    End If
    If .Range("F28").Value <> 0 Then
        dest.Offset(0, 8).Value = .Range("F28").Value 'sac vidés 0,5 €
        .Range("F28").Value = ""
    End If
    If .Range("H24").Value <> 0 Then
        dest.Offset(0, 9).Value = .Range("H24").Value 'cumul 1 €
        .Range("H24").Value = ""
    End If
    If .Range("H28").Value <> 0 Then
        dest.Offset(0, 10).Value = .Range("H28").Value 'sacs vidés 1 €
        .Range("D4").Value = ""
    End If
    If .Range("J24").Value <> 0 Then
        dest.Offset(0, 11).Value = .Range("J24").Value 'cumul 2 €
        .Range("J24").Value = ""
    End If
    If .Range("J28").Value <> 0 Then
        dest.Offset(0, 12).Value = .Range("J28").Value 'sacs vidés 2 €
        .Range("J28").Value = ""
    End If
End With
End If

Il faudra penser à supprimer dans l'initialisation de l'UserForm cette partie qui devient obsolète :

Code:

'si l'UserForm est ouvert à partir de l'onglet "Solution SAISIE en MULTIPLE"
If ActiveSheet.Name = "Solution SAISIE en MULTIPLE" Then
    'préremplissage des données récupérées sur la calculette
    With Sheets("Solution SAISIE en MULTIPLE")
        If .Range("D24").Value <> 0 Then Me.TB1.Value = .Range("D24").Value
        If .Range("D28").Value <> 0 Then Me.ComboBox3.Value = .Range("D28").Value
        If .Range("F24").Value <> 0 Then Me.TB3.Value = .Range("F24").Value
        If .Range("F28").Value <> 0 Then Me.ComboBox4.Value = .Range("F28").Value
        If .Range("H24").Value <> 0 Then Me.TB5.Value = .Range("H24").Value
        If .Range("H28").Value <> 0 Then Me.ComboBox5.Value = .Range("H28").Value
        If .Range("J24").Value <> 0 Then Me.TB7.Value = .Range("J24").Value
        If .Range("J28").Value <> 0 Then Me.ComboBox6.Value = .Range("J28").Value
    End With
End If

Webperegrino · 21 Août 2009

Re : Correction de Codes d'un formulaire de saisie Uerform

Merci Robert,

Voici ce qui se passe.
Où dans le module 4 tu fais vider la Calculette et pourquoi J10 : J10 ne se viendent pas ?
Je m'explique ci-dessous avec copie des modules.
Je suis satisfait autrement, on est à 99,999999 du final !

Je suis maintenant dans mon vrai fichier d’utilisation.
J’ai préféré y placer tes codes directement, sinon je galère pour le zipper, les modules se placeraint avec des mauvaises références dans un fichier simplifés, on aurait les manques comme l'autre jour. Je préfère donc te copier ci-après les modules.

Le Formulaire dans BD reste bien opérationnel, et fonctionne parfaitement. Merci.

Toujours dans mon vrai fichier d’utilisation, l’autre feuille de saisie multiples s’appelle maintenant « Calculette multisaisies ».
J’ai corrigé dans la codification. J’ai aussi enlevé le bouton « Formulaire » sur cette feuille, et l’ai remplacé par un bouton « VALIDER » (tu as mis Sub Valider() dans la codification, donc je reste fidèle au raisonnement.

Pour ne pas faire sauter les formules prérentrées j’ai passé en vert avec ‘ les lignes d’effacement .Range(‘’24’’).Value= ‘’ à .Range(‘’28’’).Value= ‘’ (les cellules cumul et Sacs vidés) sinon mes formules disparaissaient : fâcheux .

A l’action VALIDATION sur la Calculette :
- Toutes les valeurs se sont bien déplacées dans la Base, j'en suis très content !
- les valeurs saisies en D4, D6, la partie D12 à D20 s’effacent très bien, mais les valeurs de D10, F10, H10 et J10 restent dans les cellules… et je ne trouve pas l'endroit d'erreur dans les codes

Voici comment j’ai placé les codes en modules :

MODULE 1 :
Sub AfficheUserForm1()
UserForm1.Show
End Sub

MODULE 2 : (je crois q'elle n'est pas liée à notre travail commun mais alleurs dans le fichier à 7 feuilles).
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 04/08/2009
'
Range("E4:E5,G4:G5,D8:E10,C1517,F15:F17,J8:J17,K10").Select
Range("K10").Activate
Selection.ClearContents
End Sub

MODULE 3 :
Sub Annuler()
'
' Annuler Macro
' Macro enregistrée le 20/08/2009 par HT
'
'
Range( _
"D4:J4,D6:J6,D10,D12,D14,D16,D18,D20,F10,F12,F14,F16,F18,F20,H10,H12,H14,H16,H18,H20,J10,J12,J14,J16,J18,J20" _
).Select
Range("J20").Activate
Selection.ClearContents
Range("D10").Select
End Sub

MODULE 4

:

Sub valider()

Dim dest As Range 'déclare la variable dest (DESTination)

Set dest = Sheets("BD").Range("A65536").End(xlUp).Offset(1, 0) 'de'finit la variable dest

'envoie des données dans la base et réinitialisation de la calculette

With Sheets("Calculette multisaisies")
If .Range("D4").Value <> 0 Then
dest.Value = .Range("D4").Value 'date
.Range("D4").Value = ""
End If
If .Range("D6").Value <> 0 Then
dest.Offset(0, 2).Value = .Range("D6").Value 'lieu
.Range("D6").Value = ""
End If
If .Range("D24").Value <> 0 Then
dest.Offset(0, 5).Value = .Range("D24").Value 'cumul gratuits
'.Range("D24").Value = ""
End If
If .Range("D28").Value <> 0 Then
dest.Offset(0, 6).Value = .Range("D28").Value 'sacs vidés gratuits
'.Range("D28").Value = ""
End If
If .Range("F24").Value <> 0 Then
dest.Offset(0, 7).Value = .Range("F24").Value 'cumul 0,5 €
'.Range("F24").Value = ""
End If
If .Range("F28").Value <> 0 Then
dest.Offset(0, 8).Value = .Range("F28").Value 'sac vidés 0,5 €
'.Range("F28").Value = ""
End If
If .Range("H24").Value <> 0 Then
dest.Offset(0, 9).Value = .Range("H24").Value 'cumul 1 €
'.Range("H24").Value = ""
End If
If .Range("H28").Value <> 0 Then
dest.Offset(0, 10).Value = .Range("H28").Value 'sacs vidés 1 €
'.Range("D4").Value = ""
End If
If .Range("J24").Value <> 0 Then
dest.Offset(0, 11).Value = .Range("J24").Value 'cumul 2 €
'.Range("J24").Value = ""
End If
If .Range("J28").Value <> 0 Then
dest.Offset(0, 12).Value = .Range("J28").Value 'sacs vidés 2 €
'.Range("J28").Value = ""
End If
End With
End Sub

Webperegrino · 21 Août 2009

Re : Correction de Codes d'un formulaire de saisie Uerform

Ce qui se passe...

Robert · 21 Août 2009

Re : Correction de Codes d'un formulaire de saisie Uerform

Bonjour Webperegrino, bonjour le forun,

Bien sûr ! Il ne faut pas effacer les cellules contenant les formules mais celles contenant les données, suis-je bête !
le code modifié :

Code:

Sub valider()
Dim dest As Range 'déclare la variable dest (DESTination)
 
Set dest = Sheets("BD").Range("A65536").End(xlUp).Offset(1, 0) 'de'finit la variable dest
'envoie des données dans la base et réinitialisation de la calculette
 
With Sheets("Calculette multisaisies")
    If .Range("D4").Value <> 0 Then
        dest.Value = .Range("D4").Value 'date
        .Range("D4").Value = ""
    End If
    If .Range("D6").Value <> 0 Then
        dest.Offset(0, 2).Value = .Range("D6").Value 'lieu
        .Range("D6").Value = ""
    End If
        If .Range("D24").Value <> 0 Then
        dest.Offset(0, 5).Value = .Range("D24").Value 'cumul gratuits
    End If
    If .Range("D28").Value <> 0 Then
    dest.Offset(0, 6).Value = .Range("D28").Value 'sacs vidés gratuits
    End If
    If .Range("F24").Value <> 0 Then
    dest.Offset(0, 7).Value = .Range("F24").Value 'cumul 0,5 €
    End If
    If .Range("F28").Value <> 0 Then
    dest.Offset(0, 8).Value = .Range("F28").Value 'sac vidés 0,5 €
    End If
    If .Range("H24").Value <> 0 Then
    dest.Offset(0, 9).Value = .Range("H24").Value 'cumul 1 €
    End If
    If .Range("H28").Value <> 0 Then
    dest.Offset(0, 10).Value = .Range("H28").Value 'sacs vidés 1 €
    End If
    If .Range("J24").Value <> 0 Then
    dest.Offset(0, 11).Value = .Range("J24").Value 'cumul 2 €
    End If
    If .Range("J28").Value <> 0 Then
    dest.Offset(0, 12).Value = .Range("J28").Value 'sacs vidés 2 €
    End If
    Application.Union(.Range("D10,D12,D14,D16,D18,D20"), Range("F10,F12,F14,F16,F18,F20"), Range("H10,H12,H14,H16,H18,H20"), Range("J10,J12,J14,J16,J18,J20")).ClearContents
End With
End Sub

Webperegrino · 21 Août 2009

Re : Correction de Codes d'un formulaire de saisie Uerform

Robert,
Tu es sensationnel : je t'envoie tout plein d'ondes positives !
ON NE TOUCHE PLUS A RIEN !
TOUT FONCTIONNE : c'est clair, c'est plus rapide, ça se place au bon endroit.
Même le formulaire pour saisie à une seule valeur dans chaque catégorie, disponible en feuille Base, fonctionne également.
Que demander de plus : Rien !
La calculette est là, on y reste, pas besoin d'aller voir la Base en sous-couche : EXTRA !

Comme il y a maintenant de la place dans l'écran Calculette, je vais élargir un peu les lignes et les colonnes pour une meilleure lisibilité et ce sera plus ergonomique encore.

Je suis heureux. Je vais enfin comprendre une partie de la codification VBA., et appliquer -en petit encore-
De mon côté : au travail encore, mais plus détendu ! Arriver à comprendre tout ce que tu as créé pour que ça tourne rond.

Plus besoin de message temporaire, plus de clignotant pendant que ça passe en Base, pas besoin de confirmation de saisie passée en Base... puisqu'on voit la VIDANGE de la calculette et le signalement immédiat du n° de prochaine ligne à saisir.

Ç'est le bonheur ! Tiens, je me verse 1,5 cm de Whiskey et porte bien haut le verre en ton honneur.

Merci, Merci, Merci
A plus tard, peut-être pour une autre énigme
C'est promis, ce soir, je dors !
Toute mon amitié
Webperegrino

Robert · 21 Août 2009

Re : Correction de Codes d'un formulaire de saisie Uerform

Bonjour Webperegrino, bonjour le fourm,

Devant tant d'enthousiasme je ne peux que m'en verser un moi aussi et trinquer avec toi...

Correction de Codes d'un formulaire de saisie Uerform

Webperegrino

XLDnaute Impliqué

Pièces jointes

Robert

XLDnaute Barbatruc

Webperegrino

XLDnaute Impliqué

Webperegrino

XLDnaute Impliqué

Pièces jointes

Robert

XLDnaute Barbatruc

Webperegrino

XLDnaute Impliqué

Robert

XLDnaute Barbatruc

Discussions similaires