VBA validation questionnaire, insertion automatique réponses

Le 12/03/2011 à 13:20

Bonjour a tous,

J'ai effectué un questionnaire excel et je souhaite qu'en cliquant sur une macro, les réponses soient automatiquement envoyés sur une feuille "Résultats" à chaque clique sur un macro à la fin du questionnaire. Ce macro a aussi pour fonction d'envoyer le participant à la fin de son questionnaire dur une page de remerciements.

J'ai donc fait un code VBA qui me semble bon mais il ne fonctionne pas: les réponses ne s’enchaînent pas à chaque validation du questionnaire. Par contre l'envoie sur la page de remerciements s'effectue correctement.

Je ne peux pas mettre mon fichier excel en pièce jointe car le fichier est trop gros. Je peux donc vous l'envoyer par mail si vous me donnez votre adresse.

Merci beaucoup par avance, c'est assez urgent!

-- 12 Mar 2011, 14:06 --

Vu que je ne peux pas mettre mon fichier excel en pièces jointe, je vous mets quand même mon code VBA.

Sub BoutonAllerMerci_QuandClic()

' BoutonAllerMerci_QuandClic Macro
' Lorque le particpant clique sur le macro, une page s'affiche pour le remercier et lui dire que ses réponses sont bien validées
Sheets("Merci").Select

'Lorsque le participant n'a pas coché 2 cases à la derniere question, il en est averti et bloqué

If [TotauxChoix] = 1 Then
    MsgBox "Attention: le nombre de cases à cocher à la dernière question est de 2!", vbExclamation, "Validation du questionnaire"
    Sheets("Questionnaire").Select

End If

If [TotauxChoix] = 0 Then
    MsgBox "Attention: le nombre de cases à cocher à la dernière question est de 2!", vbExclamation, "Validation du questionnaire"
    Sheets("Questionnaire").Select

End If

' Lorsque le participant n'a pas rentré son prénom, il en est averti et bloqué
Dim ChaineSaisie2 As String
   'Vérification du Nom
   If [Prenom] = "" Then
     ChaineSaisie2 = InputBox("Veuillez indiquer votre prénom!")
     If ChaineSaisie2 = "" Then
       MsgBox "Veuillez indiquer votre prénom!", vbExclamation, "Validation du questionnaire"
       Sheets("Questionnaire").Select
       [C5].Select

     Else
       [Prenom] = ChaineSaisie2
        End If
   End If

'Ajoute dans [TableResultats] l'élément de la ligne récapitulative
' Macro enregistrée
    'Sheets("Résultats").Select
    'Range("A3").Select
    'Selection.EntireRow.Insert
    'Range("A1:I1").Select
    'Selection.Copy
    'Range("A3").Select
    'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    '    False, Transpose:=False
    'Range("A4:I4").Select
    'Application.CutCopyMode = False
    'Selection.Copy
    'Range("A5:I5").Select
    'Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    '    False, Transpose:=False
    'Application.CutCopyMode = False

' Simplification de la macro enregistrée
If [Prenom] = ChaineSaisie2 Then
    'Insertion d'une ligne en début de table
    'Sheets("Résultats").Select
    'Range("A3").Select
    'Selection.EntireRow.Insert
    [TableResultats].Rows(2).Insert Shift:=xlDown
    'Range("A1:I1").Select
    'Selection.Copy
    [LigneSource].Copy
    'Range("A3").Select
    'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    '    False, Transpose:=False
    [TableResultats].Cells(2, 1).PasteSpecial Paste:=xlValues
    'Range("A4:I4").Select
    'Application.CutCopyMode = False
    'Selection.Copy
    [TableResultats].Rows(3).Copy
    'Range("A3:I3").Select
    'Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    '    False, Transpose:=False
    [TableResultats].Rows(2).PasteSpecial Paste:=xlFormats
    'Application.CutCopyMode = False
    Application.CutCopyMode = False

    'Tri de la table par ordre alphabétique des noms (1ere colonne)
    [TableResultats].Sort Key1:=[TableResultats].Columns(1), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End If
End Sub
Le 12/03/2011 à 14:25

Bonjour et bienvenue,

Il nous faut le fichier,

s'il est trop gros même compressé, essaye d'utiliser ce lien (gratuit)

utilise ce lien http://www.cjoint.com

Amicalement

Claude

Le 12/03/2011 à 14:40

Voici le lien créé!

Amicalement

Le 12/03/2011 à 17:39

Bonjour

A tester

Sub BoutonAllerMerci_QuandClic()
' BoutonAllerMerci_QuandClic Macro
' Lorque le particpant clique sur le macro, une page s'affiche pour le remercier et lui dire que ses réponses sont bien validées

' Lorsque le participant n'a pas rentré son prénom, il en est averti et bloqué
  [Prenom] = [E5]
  If [Prenom] = "" Then
    Do
      [Prenom] = InputBox("Veuillez indiquer votre prénom!")
    Loop Until [Prenom] <> ""
  End If

  'Lorsque le participant n'a pas coché 2 cases à la derniere question, il en est averti et bloqué
  If [TotauxChoix] < 2 Then
    MsgBox "Attention: le nombre de cases à cocher à la dernière question est de 2!", vbExclamation, "Validation du questionnaire"
    Sheets("Questionnaire").Select
    Exit Sub
  End If

  Sheets("Merci").Select

  [LigneSource].Copy
  [TableResultats].Rows(2).Insert
  [TableResultats].Rows(2).Value = [TableResultats].Rows(2).Value

  'Tri de la table par ordre alphabétique des noms (1ere colonne)
  [TableResultats].Sort Key1:=[TableResultats].Columns(1), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Bonne journée

Le 12/03/2011 à 22:13

Bonsoir léouli, Banzai64, forum,

Avec contrôle complet des réponses et remise à zéro après validation

Il faut supprimer carrément les modules 1 et 2 (les "Sub Caseàcocher1_Clic()")

supprimer aussi l'affectation de ces macros sur les cases à cocher (de la fin)

Sub ValiderSaisie()
Dim Plg As Range, Cel As Range, Lg%, i%

    '--- Contrôle saisie ---
    [Prenom] = Application.Proper(InputBox("Veuillez indiquer votre prénom!"))
    If [Prenom] = "" Then Exit Sub

    Set Plg = Union(Range("g11"), Range("g18"), Range("g25"), Range("g31"), _
    Range("g38"), Range("g45"), Range("g53"), Range("h65"))

    For Each Cel In Plg
        If Cel = "" Or Cel = 0 Then
            Select Case Cel.Row
                Case Is = 11: i = 7
                Case Is = 18: i = 14
                Case Is = 25: i = 22
                Case Is = 31: i = 30
                Case Is = 38: i = 35
                Case Is = 45: i = 42
                Case Is = 53: i = 49
                Case Is = 65: i = 58
                Case Else: Exit Sub
            End Select
            Range("a" & i).Select
            MsgBox (Range("a" & i)) '& Chr(10)) '& " réponse ?")
            Exit Sub
         End If
    Next Cel
    If [TotauxChoix] <> 2 Then
        MsgBox "Attention: le nombre de cases à cocher à la dernière question est de 2!", vbExclamation, "Validation du questionnaire"
        Exit Sub
    End If
    '--- fin du contrôle ---
    '--- Ajoute dans [TableResultats] l'élément de la ligne récapitulative
        With Sheets("Résultats")
            Lg = .Range("a65536").End(xlUp)(2).Row
            .Range("a1:i1").Copy
            .Range("a" & Lg).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            '--- tri ---
            .Range("a3:i" & Lg).Sort Key1:=.Range("a3"), Order1:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False
        End With

    '--- efface le questionnaire ---
    Range("e5:g5").ClearContents        'prénom
    Union(Range("g11"), Range("g18"), Range("g25"), Range("g31"), _
    Range("g38"), Range("g45"), Range("g53"), Range("g60:g64")).ClearContents
        Sheets("Merci").Activate
End Sub

à noter qu'il y a beaucoup trop de noms/définis sur ce fichier !

Amicalement

Claude

Le 13/03/2011 à 10:43

C'est bon merci, j'ai réussi à résoudre mon problème!!

Merci à tous!

Rechercher des sujets similaires à "vba validation questionnaire insertion automatique reponses"