Correction de Codes d'un formulaire de saisie Uerform

W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • Liste codes VBA Formulaire-Transfert dans Base 'BD'.xls
    49 KB · Affichages: 140
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
 
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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,C15:D17,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
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
 
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 
Vote positif 0 Vote négatif

Discussions similaires

W
  • Résolu(e)
XL 2016 Problème de comptage pour trouver les trois meilleurs
2
Réponses
19
Affichages
793
Webperegrino
W
jeff1494
  • Question
XL 2021 Saisie de lignes multiples dans un formulaire
2
Réponses
15
Affichages
668
jeff1494
jeff1494
O
  • Question
XL 2019 boutons sur formulaire non fonctionnels
2 3
Réponses
35
Affichages
1 K
olivier1984
O
D
  • Résolu(e)
XL 2021 VBA Formulaire
2
Réponses
27
Affichages
1 K
delsart59
D
O
  • Question
XL 2019 resoudre la loudeur de Bdd du vba
Réponses
4
Affichages
456
mapomme
mapomme
G
  • Question
XL 2019 création bulletin de paie
Réponses
6
Affichages
587
vgendron
vgendron
S
  • Résolu(e)
XL 2016 Problème de contenu, fichier verrouillée pour modification et s'ouvre uniquement en lecture seule
Réponses
2
Affichages
261
Stéphane_1
S
O
  • Question
XL 2019 Optimiser la loudeur de mon code VBA
Réponses
1
Affichages
299
Dranreb
Dranreb
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
477
olivieroma
O
G
  • Résolu(e)
Microsoft 365 Formulaire saisie
Réponses
3
Affichages
607
gpion
G

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 27 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 194
Messages
2 117 157
Membres
113 023
dernier inscrit
bilal h