|
| Precedente :: Successivo |
| Autore |
Messaggio |
hermes
Comune mortale
Registrato: 23/05/11 18:47
Messaggi: 4
|
 Inviato: 23 Mag 2011 18:57 Oggetto: * Realizzare un questionario con campi attivati da risposte |
 |
|
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 
Grazie mille a tutti! |
|
| Top |
|
 |
madvero
Amministratore
Registrato: 05/07/05 21:42
Messaggi: 19518
Residenza: L'immagine ha il solo scopo di rappresentare il prodotto.
|
| Inviato: 23 Mag 2011 22:45 Oggetto: |
|
|
dipende da quante siano le domande.
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 |
|
|
madvero
Amministratore
Registrato: 05/07/05 21:42
Messaggi: 19518
Residenza: L'immagine ha il solo scopo di rappresentare il prodotto.
|
| Inviato: 23 Mag 2011 22:47 Oggetto: |
|
|
| ma tu vorresti tipo usare gli strumenti di controllo di word però a cascata? |
|
| Top |
|
|
hermes
Comune mortale
Registrato: 23/05/11 18:47
Messaggi: 4
|
| Inviato: 24 Mag 2011 00:04 Oggetto: |
|
|
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 )
Grazie. |
|
| Top |
|
|
madvero
Amministratore
Registrato: 05/07/05 21:42
Messaggi: 19518
Residenza: L'immagine ha il solo scopo di rappresentare il prodotto.
|
| Inviato: 25 Mag 2011 23:45 Oggetto: |
|
|
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  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 controlloe 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
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 |
|
|
hermes
Comune mortale
Registrato: 23/05/11 18:47
Messaggi: 4
|
| Inviato: 26 Mag 2011 09:08 Oggetto: |
|
|
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 |
|
|
Taurex
Moderatore Software e Sistemi Operativi
Registrato: 10/10/04 11:44
Messaggi: 1057
Residenza: Internet
|
| Inviato: 14 Giu 2011 06:00 Oggetto: |
|
|
| e farlo in excel? |
|
| Top |
|
|
hermes
Comune mortale
Registrato: 23/05/11 18:47
Messaggi: 4
|
| Inviato: 14 Giu 2011 12:24 Oggetto: |
|
|
| Se pensi che si possa fare in excel ben venga. Consigli? |
|
| Top |
|
|
madvero
Amministratore
Registrato: 05/07/05 21:42
Messaggi: 19518
Residenza: L'immagine ha il solo scopo di rappresentare il prodotto.
|
| Inviato: 15 Giu 2011 20:37 Oggetto: |
|
|
| 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 |
|
| Top |
|
|
Taurex
Moderatore Software e Sistemi Operativi
Registrato: 10/10/04 11:44
Messaggi: 1057
Residenza: Internet
|
| Inviato: 22 Giu 2011 09:26 Oggetto: |
|
|
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 |
|
|
madvero
Amministratore
Registrato: 05/07/05 21:42
Messaggi: 19518
Residenza: L'immagine ha il solo scopo di rappresentare il prodotto.
|
| Inviato: 23 Giu 2011 22:21 Oggetto: |
|
|
magnifico! come hai fatto?
comunque se cacci le righe in vba le incolliamo nel vba di word e funziona lo stesso... |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 27 Giu 2011 14:51 Oggetto: |
|
|
| 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 
Comunque, appena ho tempo 
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 |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 28 Giu 2011 06:43 Oggetto: |
|
|
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 
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
.2 NON intercalare "righe bianche" nel file questionario
Per problemi: cà sugno [appena ho tempo] |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 30 Giu 2011 00:21 Oggetto: |
|
|
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 |
|
|
madvero
Amministratore
Registrato: 05/07/05 21:42
Messaggi: 19518
Residenza: L'immagine ha il solo scopo di rappresentare il prodotto.
|
| Inviato: 22 Lug 2011 22:29 Oggetto: |
|
|
(lo copincollerò passivamente e non lo comprenderò mai, ma l'importante è che funzioni.
grandissimo!!!) |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 23 Lug 2011 11:37 Oggetto: |
 |
|
| madvero ha scritto: |
(lo copincollerò passivamente e non lo comprenderò mai, ma l'importante è che funzioni.
grandissimo!!!) |
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. |
|
| Top |
|
|
|
|
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
|
|
FAQ
Cerca
Lista utenti
Gruppi
Registrati
Profilo
Messaggi privati
Log in
