Indice del forum Olimpo Informatico
I Forum di Zeus News
Leggi la newsletter gratuita - Attiva il Menu compatto
 
 FAQFAQ   CercaCerca   Lista utentiLista utenti   GruppiGruppi   RegistratiRegistrati 
 ProfiloProfilo   Messaggi privatiMessaggi privati   Log inLog in 

    Newsletter RSS Facebook Twitter Contatti Ricerca
* Realizzare un questionario con campi attivati da risposte
Nuovo argomento   Rispondi    Indice del forum -> Office e LibreOffice
Precedente :: Successivo  
Autore Messaggio
hermes
Comune mortale
Comune mortale


Registrato: 23/05/11 17:47
Messaggi: 4

MessaggioInviato: 23 Mag 2011 17:57    Oggetto: * Realizzare un questionario con campi attivati da risposte Rispondi citando

Salve a tutti, sono nuovo del forum quindi se commetto qualche errore nel postare correggetemi pure.
Vorrei realizzare un questionario nel quale alcuni campi si attivano a seconda della risposta data ad una precedente domanda.
Ad esempio se viene selezionata la prima risposta di un menù a discesa si deve rispondere alla successiva domanda A, se viene selezionata la seconda invece si deve rispondere alla successiva domanda B, e così via.
Innanzitutto vorrei capire se il programma più adatto è Word o Access (o qualcos'altro ancora).
Poi vorrei capire il comando (o la macro o la funzione) da utilizzare.
Come fare?
Vi prego aiutatemi Sad
Grazie mille a tutti!
Top
Profilo Invia messaggio privato
madvero
Amministratore
Amministratore


Registrato: 05/07/05 20:42
Messaggi: 19288
Residenza: Ero il maestro Zen. Scrivevo piccole poesie Haiku. Le mandavo a tutti via e-mail.

MessaggioInviato: 23 Mag 2011 21:45    Oggetto: Rispondi citando

dipende da quante siano le domande.

Rolling Eyes Rolling Eyes Rolling Eyes

io in genere faccio come i poveri di spirito: mi creo in excel un database a mio uso e consumo, poi faccio le macro su word utilizzando i classici campi unione...
però la cosa mi serve a generare tot documenti diversi, non tanto per creare un quiz.
Top
Profilo Invia messaggio privato Invia e-mail HomePage
madvero
Amministratore
Amministratore


Registrato: 05/07/05 20:42
Messaggi: 19288
Residenza: Ero il maestro Zen. Scrivevo piccole poesie Haiku. Le mandavo a tutti via e-mail.

MessaggioInviato: 23 Mag 2011 21:47    Oggetto: Rispondi citando

ma tu vorresti tipo usare gli strumenti di controllo di word però a cascata?
Top
Profilo Invia messaggio privato Invia e-mail HomePage
hermes
Comune mortale
Comune mortale


Registrato: 23/05/11 17:47
Messaggi: 4

MessaggioInviato: 23 Mag 2011 23:04    Oggetto: Rispondi citando

Innanzitutto grazie per le risposte.
Cerco di chiarire meglio quello di cui avrei bisogno.
Mettiamo di avere un questionario con 3 domande.
La prima domanda ha due risposte (A o B).
Se si risponde A, si deve rispondere alla domanda 2 e non alla 3, che rimane quindi inattiva (non so come dirlo: non deve essere possibile selezionare una risposta per questa domanda).
Se si risponde B, si deve rispondere alla domanda 3 e non alla 2.
E così via si potrebbe proseguire all'infinito.
Ho utilizzato questionari come questo ad esempio nei sondaggi on-line.
Idee? (se sono riferite a macro potreste essere il più espliciti possibile? Non conosco molto bene l'argomento Sad)
Grazie.
Top
Profilo Invia messaggio privato
madvero
Amministratore
Amministratore


Registrato: 05/07/05 20:42
Messaggi: 19288
Residenza: Ero il maestro Zen. Scrivevo piccole poesie Haiku. Le mandavo a tutti via e-mail.

MessaggioInviato: 25 Mag 2011 22:45    Oggetto: Rispondi citando

premetto che non ti sarò affatto utile perchè a creare un questionario checkabile non ci vuol niente (ora ti faccio vedere) ma mi inchiodo nel momento in cui si devono inserire i controlli, perchè in visual basic sono una bestia.

ti faccio vedere comunque come creare un questionario checkabile, anche se non ti servirà affatto (salvo non passi qualche programmatore Very Happy a darci il “la”)

nota bene: mai toccare il normal.dot, che si trova di solito in
c:\documents and settings\nome utente\dati applicazioni\microsoft\modelli

quel che intendo io è creare un modello a proprio uso e consumo, salvarlo come doc e distribuirlo.

per prima cosa, apri un nuovo foglio word bianco.
poi salvalo come modello, facendo file -> salva con nome e cliccando modello di documento (*dot) nel menù a tendina accanto al tipo di file.
la path giusta per il modello te la trova il pc in automatico (ma è quella che ti ho detto prima).
io ho chiamato questo nuovo modello questionario.
ovviamente ha estensione .dot



ok, compila il foglio bianco con tutte le domande e le possibili risposte.
io ne ho messe tre, a casaccio.
è chiaro l'intento (nella stesura delle domande) di skippare dalla prima alla terza sulla base della prima risposta.

Codice:
1) sei single?                        sì                     no
2) vuoi una relazione stabile?         sì                  no
3) da quanto state insieme?      meno di un anno      più di un anno


predisposte tutte le domande e le opzioni di risposta, bisogna visualizzare i moduli e inserirli.
ovvero
file -> visualizza -> barre degli strumenti -> moduli
file -> visualizza -> barre degli strumenti -> strumenti di controllo
e ti appaiono queste due barre



poi col mouse nel documento ti posizioni accanto alle possibili risposte e clicchi sul campo modulo caselle di controllo
cioè questo



in modo che ti escano fuori i vari quadratini da checkare.
se non ti piace, togli l'ombreggiatura (io l'ho levata. è il pulsante a)

poi clicchi su modalità progettazione cioè questo



e infine sul lucchetto, il proteggi modulo, ovvero questo



infine, salva ancora il file come questionario.dot
ti chiederà di sovrascrivere il file esistente.
accetta Very Happy

per avere il comune documento word da compilare, ti basta aprire questionario.dot e salvarlo come questionario.doc

questo è lo specifico file che ho usato per l'esempio, scaricalo e guardalo.
puoi mettere il check su tutte le risposte, e ti basta salvare il doc per avere il questionario compilato da ogni tuo corrispondente però...
non ti serve allo scopo.

basterebbe sapere le tre righe da scrivere in visual basic per poter escludere le domande sulla base delle risposte già date...



ma io non so metterci mano.
te l'ho detto, in genere word lo uso giusto per lanciare le stampe unione e farmi produrre tipo mille documenti personalizzati sulla base di valori che ho inserito in tabelle excel.
Top
Profilo Invia messaggio privato Invia e-mail HomePage
hermes
Comune mortale
Comune mortale


Registrato: 23/05/11 17:47
Messaggi: 4

MessaggioInviato: 26 Mag 2011 08:08    Oggetto: Rispondi citando

Grazie mille.
Infatti fino alla realizzazione del questionario è utto ok.
I problemi sorgono nell'inserire le righe in VBA.
Speriamo che passi un programmatore...
Top
Profilo Invia messaggio privato
Taurex
Moderatore Software e Sistemi Operativi
Moderatore Software e Sistemi Operativi


Registrato: 10/10/04 10:44
Messaggi: 1057
Residenza: Internet

MessaggioInviato: 14 Giu 2011 05:00    Oggetto: Rispondi citando

e farlo in excel?
Top
Profilo Invia messaggio privato
hermes
Comune mortale
Comune mortale


Registrato: 23/05/11 17:47
Messaggi: 4

MessaggioInviato: 14 Giu 2011 11:24    Oggetto: Rispondi citando

Se pensi che si possa fare in excel ben venga. Consigli?
Top
Profilo Invia messaggio privato
madvero
Amministratore
Amministratore


Registrato: 05/07/05 20:42
Messaggi: 19288
Residenza: Ero il maestro Zen. Scrivevo piccole poesie Haiku. Le mandavo a tutti via e-mail.

MessaggioInviato: 15 Giu 2011 19:37    Oggetto: Rispondi citando

Taurex ha scritto:
e farlo in excel?

certo che sì.
ma la guida da scrivere è molto più lunga e io comunque mi inchiodo anche su un altro passaggio (metto le query, blocco le celle, proteggo il foglio ma... niente esclusioni o menù a tendina).

posta 'sta guida, vai Very Happy
Top
Profilo Invia messaggio privato Invia e-mail HomePage
Taurex
Moderatore Software e Sistemi Operativi
Moderatore Software e Sistemi Operativi


Registrato: 10/10/04 10:44
Messaggi: 1057
Residenza: Internet

MessaggioInviato: 22 Giu 2011 08:26    Oggetto: Rispondi citando

non riesco a mettere mano ad un pc da un po, sob.....

Ho buttato giù questo file su xls ma sarebbe più fluido lavorare in vba gestendo la compilazione delle varie righe in base alla variabile di risposta
link
Top
Profilo Invia messaggio privato
madvero
Amministratore
Amministratore


Registrato: 05/07/05 20:42
Messaggi: 19288
Residenza: Ero il maestro Zen. Scrivevo piccole poesie Haiku. Le mandavo a tutti via e-mail.

MessaggioInviato: 23 Giu 2011 21:21    Oggetto: Rispondi citando

magnifico! come hai fatto?
comunque se cacci le righe in vba le incolliamo nel vba di word e funziona lo stesso...
Top
Profilo Invia messaggio privato Invia e-mail HomePage
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 27 Giu 2011 13:51    Oggetto: Rispondi citando

madvero ha scritto:
magnifico! come hai fatto?
comunque se cacci le righe in vba le incolliamo nel vba di word e funziona lo stesso...


Mad, i questionari non sono proprio la cosa più semplice del mondo Wink

Comunque, appena ho tempo ROTFL ROTFL
vedo di costruire qualcosa.
Nel frattempo espongo la pseudocodifica per la costruzione del progetto:

Codice:

.1 leggere un file di testo *

.2 alimentare una matrice o un dizionario

.3beg ciclo di esplorazione matrice
  .3.1 inputbox con la domanda e le risposte
  .3.2 controllare la risposta
  .3.3 memorizzare in una seconda matrice la domada e la relativa risposta
  .3.4 cercare la risposta seguente
.3end fine ciclo

.4beg ciclo scansione risposte
  .4.1 riportare domanda e risposta nel foglio [di word o di excel]
.4end fine ciclo scansione risposte


* il file di testo deve essere così composto:
numero|domanda|opz1;opz2;...opzN|coll1;coll2;..collN
dove:
opz = possibili risposte
coll = numero della domanda collegata alla risposta scelta

NB.
L'Inputbox è la cosa più semplice: presenta una domanda alla volta e senza possibilità di ritorno o meglio: per produrre questa possibilità occorre modificare il ciclo inserendo [e trattando] nell'inputbox la costante "torna alla domanda precedente".
Top
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 28 Giu 2011 05:43    Oggetto: Rispondi citando

ecco qua

codice per il questionario
Codice:
Option Explicit
  Dim m_sFileCont         As String
'*
  Dim m_sMsg  As String
  Dim m_lIco  As Long
  Dim m_sTit  As String
  Dim m_sRisp As String

Public Sub Questionario()

  Dim sDomanda          As String
  Dim sTmp              As String
  Dim sRisp             As String
'*
  Dim avTmp1            As Variant
  Dim avTmp2            As Variant
  Dim avTmp3            As Variant
  Dim avTmp4            As Variant
  Dim avQuest           As Variant
  Dim avRisp            As Variant
'*
  Dim i1                As Integer
  Dim i2                As Integer
  Dim i3                As Integer
'*
  Dim lBuild            As Long
  Dim lAskSucc          As Long
  Dim lAskAtt           As Long
  Dim lRispAtt          As Long
'*
  Dim bOK               As Boolean

 On Error GoTo Questionario_Errori

'* lettura del file
  leggiFile "U:\Percorso\Nome_questionario.txt"

 '* separazione del contenuto in righe
  avTmp1 = Split(m_sFileCont, vbNewLine)
 
 '* controllo sul contenuto
  If UBound(avTmp1) = 0 _
 And Len(Trim(avTmp1(0))) = 0 Then
    MsgBox avTmp1(1) _
           & String(2, vbLf) _
           & "File vuoto", _
           vbExclamation + vbSystemModal, _
           "Questionario"
    Exit Sub
  End If
 
'* scansione delle righe
 
  For i1 = 0 To UBound(avTmp1)
   '* separazione della riga negli elementi previsti
    avTmp2 = Split(avTmp1(i1), "|")
   '* controllo numero elementi
    If Not UBound(avTmp2) = 3 Then
      MsgBox avTmp1(i1) _
             & String(2, vbLf) _
             & "riga incompleta", _
             vbExclamation + vbSystemModal, _
             "Questionario"
      Exit Sub
    End If
   '* alimentazione matrice questionario
   '* il questionario parte da 1
    lBuild = lBuild + 1
   '* alloca/implementa il questionario
    If Not IsArray(avQuest) Then
      ReDim avQuest(3, lBuild)
    Else
      ReDim Preserve avQuest(3, lBuild)
    End If
   '* alimenta le colonne del questionario
    For i2 = 0 To UBound(avTmp2)
     '* 0 = numero domanda
     '* 1 = domanda
     '* 2 = opzioni di risposta
     '* 3 = numero prossima domanda [relativa alla risposta]
      avQuest(i2, lBuild) = avTmp2(i2)
    Next
   '* controlla la coerenza di ropzioni di risposta
   '* con il numero della prossima domanda correlata
    avTmp3 = Split(avQuest(2, lBuild), ";")
    avTmp4 = Split(avQuest(3, lBuild), ";")
    If Not UBound(avTmp3) = UBound(avTmp4) Then
      MsgBox avQuest(2, lBuild) _
             & String(2, vbLf) _
             & avQuest(3, lBuild) _
             & String(3, vbLf) _
             & "opzioni risposta e domande correlate NON corrispondono", _
             vbExclamation + vbSystemModal, _
             "Questionario"
      Exit Sub
    End If
  Next

'* richieste del questionario
  lAskAtt = 1
  Do
    Do
      sRisp = ""
      bOK = False
     '* separa le possibili risposte
      avTmp3 = Split(avQuest(2, lAskAtt), ";")
     '* separa le prossime domande
      avTmp4 = Split(avQuest(3, lAskAtt), ";")
     '* controlla la fine del questionario
      If avTmp4(0) = "FINE" Then
        MsgBox avQuest(1, lAskAtt) _
               & String(2, vbLf) _
               & "Il Questionario è terminato", _
               vbExclamation + vbSystemModal, _
               "Questionario"
        GoSub expoRisp
      End If
      sTmp = ""
     '* costruzione delle opzioni
      For i3 = 0 To UBound(avTmp3)
        sTmp = sTmp _
             & i3 _
             & "     " _
             & avTmp3(i3) _
             & vbLf
      Next
      m_sMsg = avQuest(1, lAskAtt) _
             & String(2, vbLf) _
             & sTmp
      m_sTit = "Domanda N° " & lAskAtt
     '* richesta
      sRisp = InputBox(m_sMsg, m_sTit, sRisp)
      If Len(Trim(sRisp)) = 0 Then
        m_sMsg = "premuto 'Annulla' o non inserito valore" _
             & String(2, vbLf) _
             & "tralasciare di dare la risposta?" _
             & String(2, vbLf) _
             & "Se si tralascia la risposta" _
             & vbLf _
             & "il questionario sarà interrotto" _
             & String(2, vbLf) _
             & "Conferma?"
        m_lIco = vbQuestion + vbYesNo
        m_sTit = "CONFERMA di ANNULLO OPERAZIONE"
        Select Case MsgBox(m_sMsg, m_lIco, m_sTit)
          Case vbYes
            Exit Sub
          Case vbNo
           'continua nella richiesta
        End Select
      End If
     '* effettua il controllo sulla risposta
      If IsNumeric(sRisp) Then
        bOK = True
      End If
     '* ok è numerico
      If bOK Then
        bOK = False
        If Int(sRisp) >= 0 And Not Int(sRisp) > UBound(avTmp3) Then
         '* rientra nei limiti previsti
          bOK = True
        End If
      End If
    Loop Until bOK
   '* costruisce il vettore delle risposte
     If Not IsArray(avRisp) Then
       lRispAtt = 1
       ReDim avRisp(1, lRispAtt)
     Else
       lRispAtt = UBound(avRisp, 2) + 1
       ReDim Preserve avRisp(1, lRispAtt)
     End If
     avRisp(0, lRispAtt) = avQuest(1, lAskAtt)
     avRisp(1, lRispAtt) = avTmp3(Int(sRisp))
     m_sRisp = sRisp
    '* rileva la successiva domanda da porre
    lAskSucc = CLng(avTmp4(Int(m_sRisp)))
   '* imposta per la costruzione
    lAskAtt = lAskSucc
  Loop
  Exit Sub
 
'*===============================================================================
'* esposizione delle risposte
'* ------------------------------------------------------------------------------
expoRisp:
 
'* "pulisce le eventuali risposte precedenti
  For lRispAtt = 1 To UBound(avQuest, 2)
    With ThisWorkbook
      .Worksheets(1).Cells(lRispAtt, 1) = ""
      .Worksheets(1).Cells(lRispAtt, 2) = ""
    End With
  Next
'* espone le risposte attuali
  For lRispAtt = 1 To UBound(avRisp, 2)
    With ThisWorkbook
      .Worksheets(1).Cells(lRispAtt, 1) = avRisp(0, lRispAtt)
      .Worksheets(1).Cells(lRispAtt, 2) = avRisp(1, lRispAtt)
    End With
  Next
  Exit Sub
'*===============================================================================


'*===============================================================================
'*                      gestione errori locali   - Questionario -
'*-------------------------------------------------------------------------------

Questionario_Errori:

  m_sMsg = Err.Number _
         & vbLf _
         & Err.Description
  m_lIco = vbExclamation + vbSystemModal
  m_sTit = "Questionario"

  MsgBox m_sMsg, m_lIco, m_sTit

  On Error GoTo 0           'disattiva il gestore degli errori per questa routine

  Exit Sub
'*===============================================================================

'*---------debug --------------
  Resume 0
'*-----------------------------

End Sub

Public Sub leggiFile(sFileName)

  Dim sNextLine     As String
  Dim iFileNum      As Integer

  iFileNum = 1
  m_sFileCont = ""
  Open sFileName For Input As #iFileNum

  Do Until EOF(iFileNum)
    Line Input #iFileNum, sNextLine
    m_sFileCont = m_sFileCont _
                & sNextLine _
                & IIf(Not EOF(iFileNum), vbNewLine, "")
  Loop
  Close iFileNum

End Sub


Nome_questionario.txt
Codice:
01|Di che sesso sei?|MASCHIO;FEMMINA;NON SO|02;03;04
02|Sei Sposato?|SI;NO|05;08
03|Sei Sposata?|SI;NO|05;08
04|Hai un/a compagno/a?|SI;NO|05;08
05|Sei Felice?|SI;NO|06;07
06|Sono contento per te!|NO_RISP|FINE
07|Mi spiace davvero tanto!|NO_RISP|FINE
08|Dovresti prendere in considerazione la cosa|NO_RISP|FINE


come operare:
.1 creare un file con Nome_questionario.txt nominandolo a piacimento [si consiglia di mantenere l'estensione txt]

.2 aprire una cartella di excel

.3 creare una macro nominandola Questionario

.4 sostituire
Codice:

Sub Questionario()

End Sub

con il codice per il questionario

.5 modificare la riga:
Codice:

  leggiFile "U:\Percorso\Nome_questionario.txt"

con unità, percorso e nome scelto per l'esempio

.6 creare una barra strumenti personalizzata chiamandola, a esempio, Questionario

.7 inserire un pulsante collegato alla macro Questionario

.8 eseguire

.9 alla fine del questionario nel foglio 1 apparirà la sequenza di domande e risposte

ATTENZIONE:
funziona [per ora] con excel, per word ci sarà una seconda puntata Smile

ATTENZIONE 2:
Nel redigere il proprio elenco di domande RISPETTARE la struttura esposta nell'esempio del txt, altrimenti la macro non funziona
Codice:

numero domanda|testo domanda|possibili risposte[separate da punto e virgola|domande alla quale saltare per ogni risposta [separate da punto e virgola] 

la pipe | e il punto e virgola ; sono i separatori obbligatori
il numero delle domande a cui saltare deve essere uguale al numero delle possibili risposte [pena l'interruzione dell'esecuzione]

ATTENZIONE 3
dell'ultimo minuto:
.1 mancando il controllo sull'esistenza del numero di domanda a cui saltare CONTROLLARE molto bene che i numeri delle domande a cui saltare siano esistenti nel testo.
[probabilmente la versione 2.0 conterrà anche questo controllo Smile

.2 NON intercalare "righe bianche" nel file questionario

Per problemi: cà sugno [appena ho tempo] Wink
Top
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 29 Giu 2011 23:21    Oggetto: Rispondi citando

ed ecco la versione 2.0 8)

Cambiamenti:
.1 nel testo del questionario:
.1.1 è possibile inserire righe bianche
.1.2 è possibile inserire commenti
.1.2.1 il commento DEVE inziare con una doppia barra //
.1.3 non è necessario che la numerazione delle domande sia contigua

.2 sono stati introdotti tutti i controlli formali sulla redazione del testo

.3 è stato introdotto il controllo incrociato fra il numerro delle domande correlate alle risposte e l'esistenza della domanda

.4 è possibile applicare la macro anche a un foglio di word

modus operandi
Identico a quello già descritto nel post precedente sia in excel che in word

codice per la macro Questionario
Codice:
Option Explicit

'*
  Dim m_sFileCont         As String
'*
  Dim m_sMsg              As String
  Dim m_lIco              As Long
  Dim m_sTit              As String
  Dim m_sRisp             As String
'*
  Dim m_avQuest           As Variant
  Dim m_avRisp            As Variant

Public Sub Questionario()

  Dim sDomanda          As String
  Dim sTmp              As String
  Dim sRisp             As String
'*
  Dim avTmp1            As Variant
  Dim avTmp2            As Variant
  Dim avTmp3            As Variant
  Dim avTmp4            As Variant
'*
  Dim i1                As Integer
  Dim i2                As Integer
  Dim i3                As Integer
'*
  Dim lAskSucc          As Long
  Dim lAskAtt           As Long
  Dim lRispAtt          As Long
'*
  Dim bOK               As Boolean

 On Error GoTo Questionario_Errori

'* lettura del file
  If bleggiFile("Unità:\Percorso\Nome_questionario.txt") = False Then
   '* la macro termina per errori sul file
    Exit Sub
  End If
 
'* richieste del questionario
  lAskAtt = 1
  m_avRisp = ""
  Do
    Do
      sRisp = ""
      bOK = False
     '* separa le possibili risposte
      avTmp3 = Split(m_avQuest(2, lAskAtt), ";")
     '* separa le prossime domande
      avTmp4 = Split(m_avQuest(3, lAskAtt), ";")
     '* controlla la fine del questionario
      If avTmp4(0) = "FINE" Then
        MsgBox m_avQuest(1, lAskAtt) _
               & String(2, vbLf) _
               & "Il Questionario è terminato", _
               vbExclamation + vbSystemModal, _
               "Questionario"
        GoSub expoRisp
      End If
      sTmp = ""
     '* costruzione delle opzioni
      For i3 = 0 To UBound(avTmp3)
        sTmp = sTmp _
             & i3 _
             & "     " _
             & avTmp3(i3) _
             & vbLf
      Next
      m_sMsg = m_avQuest(1, lAskAtt) _
             & String(2, vbLf) _
             & sTmp
      m_sTit = "Domanda N° " & lAskAtt
     '* richesta
      sRisp = InputBox(m_sMsg, m_sTit, sRisp)
      If Len(Trim(sRisp)) = 0 Then
        m_sMsg = "premuto 'Annulla' o non inserito valore" _
             & String(2, vbLf) _
             & "tralasciare di dare la risposta?" _
             & String(2, vbLf) _
             & "Se si tralascia la risposta" _
             & vbLf _
             & "il questionario sarà interrotto" _
             & String(2, vbLf) _
             & "Conferma?"
        m_lIco = vbQuestion + vbYesNo
        m_sTit = "CONFERMA di ANNULLO OPERAZIONE"
        Select Case MsgBox(m_sMsg, m_lIco, m_sTit)
          Case vbYes
            Exit Sub
          Case vbNo
           'continua nella richiesta
        End Select
      End If
     '* effettua il controllo sulla risposta
      If IsNumeric(sRisp) Then
        bOK = True
      End If
     '* ok è numerico
      If bOK Then
        bOK = False
        If Int(sRisp) >= 0 And Not Int(sRisp) > UBound(avTmp3) Then
         '* rientra nei limiti previsti
          bOK = True
        End If
      End If
    Loop Until bOK
   '* costruisce il vettore delle risposte
     If Not IsArray(m_avRisp) Then
       lRispAtt = 1
       ReDim m_avRisp(1, lRispAtt)
     Else
       lRispAtt = UBound(m_avRisp, 2) + 1
       ReDim Preserve m_avRisp(1, lRispAtt)
     End If
     m_avRisp(0, lRispAtt) = m_avQuest(1, lAskAtt)
     m_avRisp(1, lRispAtt) = avTmp3(Int(sRisp))
     m_sRisp = sRisp
    '* rileva la successiva domanda da porre
    lAskSucc = CLng(avTmp4(Int(m_sRisp)))
   '* imposta per la costruzione
    lAskAtt = lAskSucc
  Loop
  Exit Sub
 
'*===============================================================================
'* esposizione delle risposte
'* ------------------------------------------------------------------------------
expoRisp:
 
'*------------------------------------------------------------------------------
'*                       Se la macro è eseguita in Excel
'*------------------------------------------------------------------------------
''* "pulisce" le eventuali risposte precedenti
'  For lRispAtt = 1 To UBound(m_avQuest, 2)
'    With ThisWorkbook
'      .Worksheets(1).Cells(lRispAtt, 1) = ""
'      .Worksheets(1).Cells(lRispAtt, 2) = ""
'    End With
'  Next
''* espone le risposte attuali
'  For lRispAtt = 1 To UBound(m_avRisp, 2)
'    With ThisWorkbook
'      .Worksheets(1).Cells(lRispAtt, 1) = m_avRisp(0, lRispAtt)
'      .Worksheets(1).Cells(lRispAtt, 2) = m_avRisp(1, lRispAtt)
'    End With
'  Next
'*------------------------------------------------------------------------------
 
'*------------------------------------------------------------------------------
'*                       Se la macro è eseguita in Word
'*------------------------------------------------------------------------------
'* "pulisce" le eventuali risposte precedenti
  Selection.EndKey Unit:=wdStory
  Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
  Selection.TypeText Text:=""
'* espone le risposte attuali
  Selection.TypeText Text:="QUESTIONARIO:" & vbTab & "Nome"
  Selection.TypeParagraph
  Selection.TypeParagraph
  Selection.TypeText Text:="Redatto da:" & vbTab & vbTab & "Cognome e nome"
  Selection.TypeParagraph
  Selection.TypeParagraph
  ActiveDocument.Tables.Add Range:=Selection.Range, _
                            NumRows:=1, _
                            NumColumns:=2, _
                            DefaultTableBehavior:=wdWord9TableBehavior, _
                            AutoFitBehavior:=wdAutoFitFixed
  With Selection.Tables(1)
    If .Style <> "Griglia tabella" Then
      .Style = "Griglia tabella"
    End If
    .ApplyStyleHeadingRows = False
    .ApplyStyleLastRow = True
    .ApplyStyleFirstColumn = True
    .ApplyStyleLastColumn = True
  End With
  For lRispAtt = 1 To UBound(m_avRisp, 2)
    With ThisDocument
      Selection.TypeText Text:=m_avRisp(0, lRispAtt)
      Selection.MoveRight Unit:=wdCell
      Selection.TypeText Text:=m_avRisp(1, lRispAtt)
     '* controlla l'ultima riga
      If Not lRispAtt = UBound(m_avRisp, 2) Then
        Selection.MoveRight Unit:=wdCell
      End If
    End With
  Next
'*------------------------------------------------------------------------------

  Exit Sub
'*===============================================================================


'*===============================================================================
'*                      gestione errori locali   - {PROCEDURE_NAME} -
'*-------------------------------------------------------------------------------

Questionario_Errori:

  m_sMsg = Err.Number _
         & vbLf _
         & Err.Description
  m_lIco = vbExclamation + vbSystemModal
  m_sTit = "Questionario"

  MsgBox m_sMsg, m_lIco, m_sTit

  On Error GoTo 0           'disattiva il gestore degli errori per questa routine

  Exit Sub
'*===============================================================================

'*---------debug --------------
  Resume 0
'*-----------------------------

End Sub

Public Function bleggiFile(sFileName) _
             As Boolean

'*                                          -----------------------------------
'*-----------------------------------------           definizioni
'*                                          -----------------------------------
  Dim sNextLine     As String
 
'* vers. 2.0 -----------------
  Dim sTmp          As String
  Dim sStep         As String
'* ---------------------------
'*
  Dim iFileNum      As Integer
'*
  Dim bResult As Boolean
'*                                          -----------------------------------
'*-----------------------------------------

'*                                          -----------------------------------
'*-----------------------------------------           impostazioni
'*                                          -----------------------------------
  On Error GoTo bleggiFile_Errori
  iFileNum = 1
  m_sFileCont = ""
'*-----------------------------------------
 
 
'*                                          -----------------------------------
'*----------------------------------------- trattamento:
'*                                          -----------------------------------
  sStep = "Lettura"
  Open sFileName For Input As #iFileNum

  Do Until EOF(iFileNum)
    Line Input #iFileNum, sNextLine
   '* vers.2.0 --------------------------------------------
    sTmp = Trim(sNextLine)
    If Len(sTmp) = 0 Then
     '* riga bianca: nessuna azione
    Else
      If InStr(sTmp, "//") > 0 Then
       '* commento: nessuna azione
      Else
        m_sFileCont = m_sFileCont _
                    & sNextLine _
                    & IIf(Not EOF(iFileNum), vbNewLine, "")
      End If
    End If
   '* ------------------------------------------------------
  Loop
  Close iFileNum

'*----------------------------------------------------------
'* vers. 2.0

  sStep = "controllo"
'* esegue i controlli formali
  bResult = bcontrollaFile

'* "gira" il risultato alla mainline
'* se controlla file ha prodotto un risultato negativo:
'* il file contiene errori formali
'* la macro [mainline] termima
  bleggiFile = bResult
 
  On Error GoTo 0          'disattiva gestore degli errori per questa routine
  Exit Function
'*----------------------------------------------------------


'*==============================================================================
'*                      gestione errori locali   - bleggiFile -
'*------------------------------------------------------------------------------

bleggiFile_Errori:

  If UCase(sStep) = "LETTURA" Then
    m_sMsg = "Modulo1.bleggiFile" _
           & String(2, vbLf) _
           & "il file:" _
           & vbLf _
           & sFileName _
           & String(2, vbLf) _
           & "NON ESISTE!"
    m_lIco = vbCritical + vbSystemModal
    m_sTit = "AVVISO"
    MsgBox m_sMsg, m_lIco, m_sTit
  End If

  On Error GoTo 0           'disattiva gestore degli errori per questa routine

  Exit Function
'*==============================================================================

'*---------debug --------------
  Resume 0
'*-----------------------------

End Function



Public Function bcontrollaFile() As Boolean
 
'*                                          -----------------------------------
'*-----------------------------------------           definizioni
'*                                          -----------------------------------
'*
  Dim sElencoErr        As String
'*
  Dim avTmp1            As Variant
  Dim avTmp2            As Variant
  Dim avTmp3            As Variant
  Dim avTmp4            As Variant
'*
  Dim i1                As Integer
  Dim i2                As Integer
  Dim i3                As Integer
  Dim i4                As Integer
'*
  Dim lBuild            As Long
'*
  Dim bERR              As Boolean
  Dim bResult           As Boolean
'*                                          -----------------------------------
'*-----------------------------------------


'*                                          -----------------------------------
'*-----------------------------------------           impostazioni
'*                                          -----------------------------------
  On Error GoTo bcontrollaFile_Errori

  m_avQuest = ""
'*-----------------------------------------
 
 
'*                                          -----------------------------------
'*----------------------------------------- trattamento:
'*                                          -----------------------------------
'* separazione del contenuto in righe
  avTmp1 = Split(m_sFileCont, vbNewLine)

'* controllo sul contenuto
  If UBound(avTmp1) = 0 _
 And Len(Trim(avTmp1(0))) = 0 Then
    MsgBox avTmp1(1) _
           & String(2, vbLf) _
           & "File vuoto", _
           vbExclamation + vbSystemModal, _
           "Questionario"
    Error.Raise 5099
  End If
 
'* scansione delle righe
  For i1 = 0 To UBound(avTmp1)
   '* separazione della riga negli elementi previsti
    avTmp2 = Split(avTmp1(i1), "|")
   '* controllo numero elementi
    If Not UBound(avTmp2) = 3 Then
      MsgBox avTmp1(i1) _
             & String(2, vbLf) _
             & "riga incompleta", _
             vbExclamation + vbSystemModal, _
             "Questionario"
      Error.Raise 5099
    End If
 
  '* controlla che il primo elemento sia un numero
    If Not IsNumeric(avTmp2(0)) Then
      MsgBox avTmp1(i1) _
             & String(2, vbLf) _
             & "numero domanda non corretto", _
             vbExclamation + vbSystemModal, _
             "Questionario"
      Error.Raise 5099
    End If
 
  '* controlla che il secondo elemento contenga del testo
    If Len(Trim((avTmp2(1)))) = 0 Then
      MsgBox avTmp1(i1) _
             & String(2, vbLf) _
             & "Il testo della domanda non esiste", _
             vbExclamation + vbSystemModal, _
             "Questionario"
      Error.Raise 5099
    End If
 
   '* controlla il numero delle opzioni di risposta
   '* con il numero della domande correlate
    avTmp3 = Split(avTmp2(2), ";")
    avTmp4 = Split(avTmp2(3), ";")
    If Not UBound(avTmp3) = UBound(avTmp4) Then
      MsgBox m_avQuest(2, lBuild) _
             & String(2, vbLf) _
             & m_avQuest(3, lBuild) _
             & String(3, vbLf) _
             & "opzioni risposta e domande correlate NON corrispondono", _
             vbExclamation + vbSystemModal, _
             "Questionario"
      Error.Raise 5099
    End If
   '* per nessun errore formale
   '* predispone per controlli incrociati
   '* alimentazione matrice questionario
   '* il questionario parte da 1
    lBuild = CLng(avTmp2(0))
   '* alloca/implementa il questionario
    If Not IsArray(m_avQuest) Then
      ReDim m_avQuest(3, lBuild)
    Else
      If lBuild > UBound(m_avQuest, 2) Then
        ReDim Preserve m_avQuest(3, lBuild)
      End If
    End If
   '* alimenta le colonne della matrice questionario
    For i2 = 0 To UBound(avTmp2)
     '* 0 = numero domanda
     '* 1 = domanda
     '* 2 = opzioni di risposta
     '* 3 = numero prossima domanda [relativa alla risposta]
      m_avQuest(i2, lBuild) = avTmp2(i2)
    Next
  Next
   
  sElencoErr = ""
  For i1 = 1 To UBound(m_avQuest, 2)
    If Len(Trim(m_avQuest(3, i1))) > 0 Then
     '* riga valida
     '* separa i numeri di domanda correlate
      avTmp4 = Split(m_avQuest(3, i1), ";")
     '* scandisce i numeri di risosta
      bERR = False
      For i4 = 0 To UBound(avTmp4)
        If UCase(avTmp4(i4)) = "FINE" Then
         '* nessun controllo è il "salto" alla fine
        Else
         '* effettua il controllo incrociato
          If avTmp4(i4) > UBound(m_avQuest, 2) Then
             '* il numero di domanda è inesistente
            bERR = True
          End If
          If Not bERR Then
            If CInt(m_avQuest(0, avTmp4(i4))) = 0 Then
             '* il numero di domanda è inesistente
              bERR = True
            End If
          End If
          If bERR Then
           '* errore sulla riga
            sElencoErr = sElencoErr _
                       & "nella riga: " _
                       & m_avQuest(0, i1) & "|" _
                       & m_avQuest(1, i1) & "|" _
                       & m_avQuest(2, i1) & "|" _
                       & m_avQuest(3, i1) & "|" _
                       & vbLf _
                       & "il numero domanda: " & avTmp4(i4) _
                       & " è INESISTENTE" _
                       & String(2, vbLf)
          End If
        End If
      Next
    End If
  Next
  If Len(sElencoErr) > 0 Then
    MsgBox "Si sono verificati i seguenti errori:" _
           & String(2, vbLf) _
           & sElencoErr _
           & String(3, vbLf) _
           & "rivedere il testo del questionario", _
           vbExclamation + vbSystemModal, _
           "Questionario"
    Error.Raise 5099
  End If
   
'* per nessun errore verificato imposta l'OK
  bResult = True
'*-----------------------------------------


'*                                          -----------------------------------
'*----------------------------------------- restituzione
'*                                          -----------------------------------
  bcontrollaFile = bResult
'*-----------------------------------------
 
 
'*                                          -----------------------------------
'*----------------------------------------- uscita
'*                                          -----------------------------------
  On Error GoTo 0                          'disattiva il gestore degli errori
                                           'per questa routine
  Exit Function
'*-----------------------------------------


'*==============================================================================
'*                      gestione errori locali   - bcontrollaFile -
'*------------------------------------------------------------------------------

bcontrollaFile_Errori:

  On Error GoTo 0           'disattiva gestore degli errori per questa routine

  Exit Function
'*==============================================================================

'*---------debug --------------
  Resume 0
'*-----------------------------


End Function


esempio del nuovo nome_questionario.txt
Codice:
// inizio
01|Di che sesso sei?|MASCHIO;FEMMINA;NON SO|11;21;31

// maschio
11|Sei Sposato?|SI;NO|41;51

// femmina
21|Sei Sposata?|SI;NO|41;51

//??
31|Hai un/a compagno/a?|SI;NO|41;51

//confluenza comune
41|Sei Felice?|SI;NO|52;53

// fine
51|Dovresti prendere in considerazione la cosa|NO_RISP|FINE
52|Sono contento per te!|NO_RISP|FINE
53|Mi spiace davvero tanto!|NO_RISP|FINE


Avvertenze
.1 fare attenzione a dove si registra la macro, è consigliabile sia assegnata al solo foglio corrente

.2 il codice sopra esposto funziona per word [mentre quello precedente funzionava per excel]

.3 a seconda di dove si deve applicare la macro occorre commentare la parte contraria e cioè:
.3.1 se si vuole applicare ad excel nella macro dovrà essere effettuata la seguente modifica:
Codice:
'*------------------------------------------------------------------------------
'*                       Se la macro è eseguita in Excel
'*------------------------------------------------------------------------------
'* "pulisce" le eventuali risposte precedenti
  For lRispAtt = 1 To UBound(m_avQuest, 2)
    With ThisWorkbook
      .Worksheets(1).Cells(lRispAtt, 1) = ""
      .Worksheets(1).Cells(lRispAtt, 2) = ""
    End With
  Next
'* espone le risposte attuali
  For lRispAtt = 1 To UBound(m_avRisp, 2)
    With ThisWorkbook
      .Worksheets(1).Cells(lRispAtt, 1) = m_avRisp(0, lRispAtt)
      .Worksheets(1).Cells(lRispAtt, 2) = m_avRisp(1, lRispAtt)
    End With
  Next
'*------------------------------------------------------------------------------
 
'*------------------------------------------------------------------------------
'*                       Se la macro è eseguita in Word
'*------------------------------------------------------------------------------
''* "pulisce" le eventuali risposte precedenti
'  Selection.EndKey Unit:=wdStory
'  Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
'  Selection.TypeText Text:=""
''* espone le risposte attuali
'  Selection.TypeText Text:="QUESTIONARIO:" & vbTab & "Nome"
'  Selection.TypeParagraph
'  Selection.TypeParagraph
'  Selection.TypeText Text:="Redatto da:" & vbTab & vbTab & '"Cognome e nome"
'  Selection.TypeParagraph
'  Selection.TypeParagraph
'  ActiveDocument.Tables.Add Range:=Selection.Range, _
'                            NumRows:=1, _
'                            NumColumns:=2, _
'                            DefaultTableBehavior:=wdWord9TableBehavior, _
'                            AutoFitBehavior:=wdAutoFitFixed
'  With Selection.Tables(1)
'    If .Style <> "Griglia tabella" Then
'      .Style = "Griglia tabella"
'    End If
'    .ApplyStyleHeadingRows = False
'    .ApplyStyleLastRow = True
'    .ApplyStyleFirstColumn = True
'    .ApplyStyleLastColumn = True
'  End With
'  For lRispAtt = 1 To UBound(m_avRisp, 2)
'    With ThisDocument
'      Selection.TypeText Text:=m_avRisp(0, lRispAtt)
'      Selection.MoveRight Unit:=wdCell
'      Selection.TypeText Text:=m_avRisp(1, lRispAtt)
'     '* controlla l'ultima riga
'      If Not lRispAtt = UBound(m_avRisp, 2) Then
'        Selection.MoveRight Unit:=wdCell
'      End If
'    End With
'  Next
''*------------------------------------------------------------------------------


.4 se si desidera far redigere il questionario in forma anonima e produrlo in un foglio di word sarà sufficiente commentare le righe:
Codice:
'  Selection.TypeParagraph
'  Selection.TypeText Text:="Redatto da:" & vbTab & vbTab & '"Cognome e nome"
'  Selection.TypeParagraph
'  Selection.TypeParagraph


Come al solito, per qualsiasi dubbio, domanda, critica:
Cà sugno

Buoni questionari 8)
Top
Profilo Invia messaggio privato
madvero
Amministratore
Amministratore


Registrato: 05/07/05 20:42
Messaggi: 19288
Residenza: Ero il maestro Zen. Scrivevo piccole poesie Haiku. Le mandavo a tutti via e-mail.

MessaggioInviato: 22 Lug 2011 21:29    Oggetto: Rispondi citando

Applause Applause Applause

(lo copincollerò passivamente e non lo comprenderò mai, ma l'importante è che funzioni.
grandissimo!!!)
Top
Profilo Invia messaggio privato Invia e-mail HomePage
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 23 Lug 2011 10:37    Oggetto: Rispondi

madvero ha scritto:
Applause Applause Applause

(lo copincollerò passivamente e non lo comprenderò mai, ma l'importante è che funzioni.
grandissimo!!!)


Grazie

Per comprenderlo dovresti conoscere il codice VBA, in realtà le istruzioni sono proprio per chi non conosce il codice.
L'impegno di chi copia e incolla deve essere diretto alla costruzione del file di testo che rappresenta le domande e la loro sequenza.
Come detto in precedenza non c'è la possibilità di tornare indietro alla domanda precedente, ma questo potrebbe essere l'argomento della release 3.0. Smile
Top
Profilo Invia messaggio privato
Mostra prima i messaggi di:   
Nuovo argomento   Rispondi    Indice del forum -> Office e LibreOffice Tutti i fusi orari sono GMT + 1 ora
Pagina 1 di 1

 
Vai a:  
Non puoi inserire nuovi argomenti
Non puoi rispondere a nessun argomento
Non puoi modificare i tuoi messaggi
Non puoi cancellare i tuoi messaggi
Non puoi votare nei sondaggi