Condividi:        

Help VBA

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Help VBA

Postdi ahidai » 05/01/12 15:17

Un saluto a tutti, in particolare ai Moderatori Flash30005 e Anthony47 sempre disponibili.
Ecco il mio problema, ho trovato in rete un file che serve per esercitarsi con i quiz (bello e funzionante), così strutturato:
Foglio1: A: nr progressivo; B: domande; C:risposta multipla1; D:risposta multipla 2; E:risposta multipla 3; F:risposta multipla 4; G:risposta esatta.

Foglio2 così strutturato:
A1:Domanda corrente; A2:PB00135
B1:Domande lette;B2:5
C1:Domande esatte;C2:2
D1:Scorrimento;D2:Sequenziale/causale
E1:Domande Totali;E2:5014

A4:Indici domande
A5, A6, A7 e cosi via: AA;AB;BA;BB;CA;CB;DA;DB;EA;EB;FA;FB;GA;GB;HA;HB;IA;IB;LA;LB;MA;MB;PA;PB;RA;RB;SA;SB;ZA;ZB.

B4:Parziali
B5, B6, B7 e cosi via: 130;132;130;130;134;130;130;131;234;233;237;238;129;130;130;130;130;130;128;130;129;130;250;250;
249;252;235;234;129;130.

Vorrei implementarlo con 5 risposte multiple e sinceramente non so cosa fare essendo un neofita in VBA.
Chiedo gentilmente se mi potete risolvere il problema.
Grazie anticipatamente.

Allego il codice usato:

Codice: Seleziona tutto
Dim RigaDomanda As Integer
Dim IndiceDomanda As Domanda
Dim DomandeLette As Integer
Dim DomandeEsatte As Integer
Dim PercentualeEsatte As Integer
Dim DomandaDaVerificare As Integer
Dim DomandeTotali As Integer
Dim UltimaDomandaCasualeRisposta As Integer


Private Sub CmbIndice_Change()
Dim Lettere As String * 2
Dim Numeri As String
Dim Cont1 As Integer
Dim Cont2 As Integer


Lettere = CmbIndice.Text
Numeri = "00001"

For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  If Lettere = IndiceDomanda.Indice(Cont1) Then
    CmbNumero.Clear
    For Cont2 = 1 To IndiceDomanda.Numero(Cont1)
      CmbNumero.AddItem Format$(CStr(Cont2), "00000")
    Next Cont2
    CmbIndice.ListIndex = Cont1
    CmbNumero.ListIndex = CInt(Numeri) - 1
  End If
Next Cont1
Call AzzeraOpzioni

CmdVerificaRisposta.SetFocus
End Sub

Private Sub CmbNumero_Change()
If (CmbNumero.ListCount > 0) Then
  RigaDomanda = RigaAssoluta(CmbIndice.Text & CmbNumero.Text)
  Call LeggiDomanda(RigaDomanda)
End If
Call AzzeraOpzioni

CmdVerificaRisposta.SetFocus
End Sub

Private Sub CmdAzzeramento_Click()
Dim Risposta As VbMsgBoxResult

Risposta = MsgBox("Azzerare il conteggio ?", vbInformation + vbYesNo, "Attenzione")
If Risposta = vbYes Then
  DomandeLette = 0
  DomandeEsatte = 0
  PercentualeEsatte = 0
  DomandaDaVerificare = 0

  Call NascondiFaccine
  LblLette.Caption = CStr(DomandeLette)
  LblEsatte.Caption = CStr(DomandeEsatte)
  LblPercEsatte.Caption = CStr(PercentualeEsatte) & " %"
  Me.MousePointer = 13
  Foglio1.Range("H1:H1").EntireColumn.Delete
  Me.MousePointer = 0
End If
Call AzzeraOpzioni

CmdVerificaRisposta.SetFocus
End Sub

Private Sub CmdIndietro_Click()
Dim Numero As Integer
Dim Cont As Integer


If OptSequenziale.Value = True Then
  If RigaDomanda > 1 Then
    RigaDomanda = RigaDomanda - 1
    Call LeggiDomanda(RigaDomanda)
    Call AzzeraOpzioni
  End If
 
ElseIf OptCasuale.Value = True Then
  If UltimaDomandaCasualeRisposta > 0 Then
    RigaDomanda = UltimaDomandaCasualeRisposta

    Call LeggiDomanda(RigaDomanda)
    Call AzzeraOpzioni
  End If
End If

Call AggiornaCombo
DomandaDaVerificare = 0
CmdVerificaRisposta.SetFocus
End Sub

Private Sub CmdAvanti_Click()
Dim NumeroCasuale As Integer
Dim StrTemp As String * 1

If OptSequenziale.Value = True Then
  If RigaDomanda < DomandeTotali Then
    RigaDomanda = RigaDomanda + 1
    Call LeggiDomanda(RigaDomanda)
    Call AzzeraOpzioni
  End If
ElseIf OptCasuale.Value = True Then
  Me.MousePointer = 13
 
  Do
    Randomize Timer
    NumeroCasuale = Int((DomandeTotali * Rnd) + 1)
   
    StrTemp = Foglio1.Cells(NumeroCasuale, 8)
  Loop While (LCase(StrTemp) = "x")
 
  RigaDomanda = NumeroCasuale
  Call LeggiDomanda(RigaDomanda)
  Call AzzeraOpzioni
 
  Me.MousePointer = 0
End If

Call AggiornaCombo
DomandaDaVerificare = 0
CmdVerificaRisposta.SetFocus
End Sub

Private Sub CmdVerificaRisposta_Click()
Dim RispostaEsatta As String
Dim Cont As Integer


If ((OptRisposta1.Value = True) Or _
   (OptRisposta2.Value = True) Or _
   (OptRisposta3.Value = True) Or _
   (OptRisposta4.Value = True)) Then


  RispostaEsatta = Foglio1.Cells(RigaDomanda, 7)
  RispostaEsatta = UCase(RispostaEsatta)
  Select Case RispostaEsatta
    Case Is = "A"
      OptRisposta1.BackColor = vbGreen
      If OptRisposta1.Value <> True Then
        If OptRisposta2.Value = True Then
          OptRisposta2.BackColor = vbRed
        ElseIf OptRisposta3.Value = True Then
          OptRisposta3.BackColor = vbRed
        ElseIf OptRisposta4.Value = True Then
          OptRisposta4.BackColor = vbRed
        End If
      Else
        DomandeEsatte = DomandeEsatte + 1
      End If

    Case Is = "B"
      OptRisposta2.BackColor = vbGreen
      If OptRisposta2.Value <> True Then
        If OptRisposta1.Value = True Then
          OptRisposta1.BackColor = vbRed
        ElseIf OptRisposta3.Value = True Then
          OptRisposta3.BackColor = vbRed
        ElseIf OptRisposta4.Value = True Then
          OptRisposta4.BackColor = vbRed
        End If
      Else
        DomandeEsatte = DomandeEsatte + 1
      End If

    Case Is = "C"
      OptRisposta3.BackColor = vbGreen
      If OptRisposta3.Value <> True Then
        If OptRisposta1.Value = True Then
          OptRisposta1.BackColor = vbRed
        ElseIf OptRisposta2.Value = True Then
          OptRisposta2.BackColor = vbRed
        ElseIf OptRisposta4.Value = True Then
          OptRisposta4.BackColor = vbRed
        End If
      Else
        DomandeEsatte = DomandeEsatte + 1
      End If

    Case Is = "D"
      OptRisposta4.BackColor = vbGreen
      If OptRisposta4.Value <> True Then
        If OptRisposta1.Value = True Then
          OptRisposta1.BackColor = vbRed
        ElseIf OptRisposta2.Value = True Then
          OptRisposta2.BackColor = vbRed
        ElseIf OptRisposta3.Value = True Then
          OptRisposta3.BackColor = vbRed
        End If
      Else
        DomandeEsatte = DomandeEsatte + 1
      End If
  End Select

  If (LCase(Foglio1.Cells(RigaDomanda, 8)) <> "x") Then
    DomandaDaVerificare = RigaDomanda
    DomandeLette = DomandeLette + 1
    Call ModificaFaccina
    LblLette.Caption = CStr(DomandeLette)
    LblEsatte.Caption = CStr(DomandeEsatte)
    LblPercEsatte.Caption = CStr(PercentualeEsatte) & " %"

    Foglio1.Cells(RigaDomanda, 8) = "x"
    Foglio1.Range("H" & CStr(RigaDomanda), "H" & CStr(RigaDomanda)).HorizontalAlignment = xlHAlignCenter
  End If
  UltimaDomandaCasualeRisposta = RigaDomanda
 
Else

  MsgBox "Selezionare almeno una risposta !", vbExclamation, "Attenzione"

End If

End Sub

Private Sub Esci_Click()
Call SalvaImpostazioniQuiz
Lavoro.Save
Application.DisplayAlerts = False
'ActiveWorkbook.Save
Application.DisplayAlerts = True
xChiudi = True
' SE VUOI CHIUDERE IL DOCUMENTO SUL QUALE _
  STAI LAVORANDO E LASCIARE EXCEL APERTO _
  TOGLI L 'APICINO ALLA SEGUENTE ISTRUZIONE _
  E METTILO A QUELLA SUCCESSIVA

ActiveWorkbook.Close

' SE INVECE VUOI CHIUDERE COMPLETAMENTE EXCEL _
  LASCIA LE COSE COSI'
 
'Application.Quit

End Sub


Private Sub FraAndamento_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub FraRiferimenti_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub Img10_Click()

End Sub

Private Sub LblCapEsatte_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblCapIndice_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblCapLette_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblCapNumero_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblCapPercEsatte_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblEsatte_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblLette_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub LblPercEsatte_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub OptCasuale_Click()
CmbIndice.Enabled = False
CmbNumero.Enabled = False
CmdVerificaRisposta.SetFocus
End Sub

Private Sub OptRisposta1_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub OptRisposta2_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub OptRisposta3_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub OptRisposta4_Click()
CmdVerificaRisposta.SetFocus
End Sub

Private Sub OptSequenziale_Click()
CmbIndice.Enabled = True
CmbNumero.Enabled = True
CmdVerificaRisposta.SetFocus
End Sub

Private Sub UserForm_Activate()
Dim Cont1 As Integer
Dim NumeroCasuale As Integer
Dim StrTemp As String * 1


Call VerificaVettoreDomande(IndiceDomanda)
Call CaricaImpostazioniQuiz

'Caricamento domanda casuale
If OptCasuale.Value = True Then
  Me.MousePointer = 13
 
  Do
    Randomize Timer
    NumeroCasuale = Int((DomandeTotali * Rnd) + 1)
   
    StrTemp = Foglio1.Cells(NumeroCasuale, 8)
  Loop While (LCase(StrTemp) = "x")
 
  RigaDomanda = NumeroCasuale
  Call LeggiDomanda(RigaDomanda)
 
  Me.MousePointer = 0
End If

Call LeggiDomanda(RigaDomanda)


For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  CmbIndice.AddItem IndiceDomanda.Indice(Cont1)
Next Cont1

Call AggiornaCombo
Foglio3.Activate
Foglio3.Range("F22:F22").Select

CmdVerificaRisposta.SetFocus
End Sub

Private Sub UserForm_Terminate()
Call SalvaImpostazioniQuiz
Lavoro.Save
Application.DisplayAlerts = False
'ActiveWorkbook.Save
Application.DisplayAlerts = True
xChiudi = True
' SE VUOI CHIUDERE IL DOCUMENTO SUL QUALE _
  STAI LAVORANDO E LASCIARE EXCEL APERTO _
  TOGLI L 'APICINO ALLA SEGUENTE ISTRUZIONE _
  E METTILO A QUELLA SUCCESSIVA

ActiveWorkbook.Close

' SE INVECE VUOI CHIUDERE COMPLETAMENTE EXCEL _
  LASCIA LE COSE COSI'
 
'Application.Quit
End Sub



'--------------------
'Procedure e funzioni
'--------------------

Codice: Seleziona tutto
Private Sub AggiornaCombo()
Dim Lettere As String * 2
Dim Numeri As String
Dim Cont1 As Integer
Dim Cont2 As Integer


Lettere = Mid$(LblNumDomanda.Caption, 1&, 2&)
Numeri = Mid$(LblNumDomanda.Caption, 3&)

For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  If Lettere = IndiceDomanda.Indice(Cont1) Then
    CmbNumero.Clear
    For Cont2 = 1 To IndiceDomanda.Numero(Cont1)
      CmbNumero.AddItem Format$(Cont2, "00000")
    Next Cont2
    CmbIndice.ListIndex = Cont1
    CmbNumero.ListIndex = CInt(Numeri) - 1
  End If
Next Cont1

End Sub

Private Sub CaricaImpostazioniQuiz()

With Foglio2
  RigaDomanda = RigaAssoluta(.Cells(2, 1))
  DomandeLette = CInt(.Cells(2, 2))
  DomandeEsatte = CInt(.Cells(2, 3))
 
  If .Cells(2, 4) = "Sequenziale" Then
    OptSequenziale.Value = True
  ElseIf .Cells(2, 4) = "Casuale" Then
    OptCasuale.Value = True
  End If

End With

Call ModificaFaccina
LblLette.Caption = CStr(DomandeLette)
LblEsatte.Caption = CStr(DomandeEsatte)
LblPercEsatte.Caption = CStr(PercentualeEsatte) & " %"

End Sub

Private Sub SalvaImpostazioniQuiz()
Dim Lettere As String * 2
Dim Numeri As String


Lettere = Mid$(LblNumDomanda.Caption, 1&, 2&)
Numeri = Mid$(LblNumDomanda.Caption, 3&)

If RigaDomanda < DomandeTotali Then
  Numeri = Format$(CInt(Numeri) + 1, "00000")
End If

With Foglio2
  .Cells(2, 1) = (Lettere & Numeri)
  .Cells(2, 2) = CStr(DomandeLette)
  .Cells(2, 3) = CStr(DomandeEsatte)

  If OptSequenziale.Value = True Then
    .Cells(2, 4) = "Sequenziale"
  ElseIf OptCasuale.Value = True Then
    .Cells(2, 4) = "Casuale"
  End If
 
End With
End Sub

Private Sub LeggiDomanda(ByVal NumDomanda As Integer)
 
With Foglio1
  LblNumDomanda.Caption = .Cells(NumDomanda, 1)
  LblDomanda.Caption = .Cells(NumDomanda, 2)
  OptRisposta1.Caption = .Cells(NumDomanda, 3)
  OptRisposta2.Caption = .Cells(NumDomanda, 4)
  OptRisposta3.Caption = .Cells(NumDomanda, 5)
  OptRisposta4.Caption = .Cells(NumDomanda, 6)

End With
End Sub

Private Function RigaAssoluta(ByVal CodiceDomanda As String) As Integer
Dim Lettere As String * 2
Dim Numeri As String
Dim Cont1 As Integer


Lettere = Mid$(CodiceDomanda, 1&, 2&)
Numeri = Mid$(CodiceDomanda, 3&)

For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  If Lettere = IndiceDomanda.Indice(Cont1) Then
    RigaAssoluta = RigaAssoluta + CInt(Numeri)
    Exit For
  Else
    RigaAssoluta = RigaAssoluta + IndiceDomanda.Numero(Cont1)
  End If
Next Cont1
End Function

Private Sub ModificaFaccina()

If (DomandeLette > 0) Then
  If (DomandeEsatte > 0) Then
    PercentualeEsatte = CInt(Round(DomandeEsatte / DomandeLette, 2&) * 100)
  Else
    PercentualeEsatte = 0
  End If

  Call NascondiFaccine
 
  If (PercentualeEsatte >= 90) Then
    Img10.Visible = True
  ElseIf (PercentualeEsatte >= 80) And (PercentualeEsatte < 90) Then
    Img9.Visible = True
  ElseIf (PercentualeEsatte >= 70) And (PercentualeEsatte < 80) Then
    Img8.Visible = True
  ElseIf (PercentualeEsatte >= 60) And (PercentualeEsatte < 70) Then
    Img7.Visible = True
  ElseIf (PercentualeEsatte >= 50) And (PercentualeEsatte < 60) Then
    Img6.Visible = True
  ElseIf (PercentualeEsatte >= 40) And (PercentualeEsatte < 50) Then
    Img5.Visible = True
  ElseIf (PercentualeEsatte >= 30) And (PercentualeEsatte < 40) Then
    Img4.Visible = True
  ElseIf (PercentualeEsatte >= 20) And (PercentualeEsatte < 30) Then
    Img3.Visible = True
  ElseIf (PercentualeEsatte >= 10) And (PercentualeEsatte < 20) Then
    Img2.Visible = True
  ElseIf (PercentualeEsatte < 10) Then
    Img1.Visible = True
  End If

Else

  Call NascondiFaccine
End If
End Sub

Private Sub NascondiFaccine()
Img1.Visible = False
Img2.Visible = False
Img3.Visible = False
Img4.Visible = False
Img5.Visible = False
Img6.Visible = False
Img7.Visible = False
Img8.Visible = False
Img9.Visible = False
Img10.Visible = False
End Sub

Private Sub AzzeraOpzioni()
OptRisposta1.BackColor = &H8000000F
OptRisposta2.BackColor = &H8000000F
OptRisposta3.BackColor = &H8000000F
OptRisposta4.BackColor = &H8000000F
OptRisposta1.Value = False
OptRisposta2.Value = False
OptRisposta3.Value = False
OptRisposta4.Value = False
End Sub

Private Sub VerificaVettoreDomande(ByRef IndiceDomanda As Domanda)
Const RigheVuoteFineDomande As Integer = 5

Dim Cont1 As Integer
Dim Cont2 As Integer
Dim ContFineDomande As Integer

Dim Cella As String
Dim Totale As Integer
Dim Parziale As Integer
Dim FineDomande As Boolean


Cont1 = 5
Do
  Cella = Foglio2.Cells(Cont1, 2)
  If Len(Cella) = 0 Then
    FineDomande = True
  Else
    Totale = Totale + CInt(Cella)
    Cont1 = Cont1 + 1
  End If
Loop Until FineDomande = True
FineDomande = False

DomandeTotali = CInt(Foglio2.Cells(2, 5))

If ((DomandeTotali = 0) Or (DomandeTotali < Totale) Or (Totale = 0)) Then
  'Elimina la tabella degli indici nella scheda Impostazioni
  Do
    Cella = Foglio2.Cells(5, 1)
    If (Len(Cella) > 0) Then
      Foglio2.Range("A5:B5").EntireRow.Delete (xlShiftUp)
    End If
  Loop Until (Len(Cella) = 0)
 
  'Esegue l'analisi della scheda Domande
  Me.MousePointer = 13
  Totale = 0
  Cont1 = 1
  Cont2 = 5
 
  Do
    'Elimina eventuali righe vuote nella scheda Domande
    Cella = Foglio1.Cells(Cont1, 1)
    If Len(Cella) = 0 Then
      Foglio1.Range("A" & CStr(Cont1)).EntireRow.Delete (xlShiftUp)
      ContFineDomande = ContFineDomande + 1
      If ContFineDomande = RigheVuoteFineDomande Then
        FineDomande = True
      End If
     
    Else
      'Ricerca gli indici delle domande e li aggiunge nella scheda Impostazioni
      If Left(Cella, 2&) <> Foglio2.Cells(Cont2 - 1, 1) Then
        Foglio2.Cells(Cont2, 1) = Left$(Cella, 2&)
        Foglio2.Range("A" & CStr(Cont2), "B" & CStr(Cont2)).BorderAround (xlContinuous)
        Foglio2.Range("A" & CStr(Cont2), "B" & CStr(Cont2)).HorizontalAlignment = xlHAlignCenter
        If Cont2 > 5 Then
          Foglio2.Cells(Cont2 - 1, 2) = CStr(Parziale)
        End If
        Cont2 = Cont2 + 1
        Parziale = 0
       
      End If
      Parziale = Parziale + 1
      Totale = Totale + 1
      Cont1 = Cont1 + 1

    End If
  Loop Until FineDomande = True
 
  'Azzera la statistica e aggiorna alcuni dati nella scheda Impostazioni
  Foglio2.Cells(2, 1) = Foglio1.Cells(1, 1)
  Foglio2.Cells(2, 2) = "0"
  Foglio2.Cells(2, 3) = "0"
  Foglio2.Cells(2, 5) = CStr(Totale)
  DomandeTotali = Totale
  Foglio2.Cells(Cont2 - 1, 2) = CStr(Parziale)
  Me.MousePointer = 0

End If


'Riempimento del vettore IndiceDomanda
ReDim IndiceDomanda.Indice(0)
ReDim IndiceDomanda.Numero(0)
Cont1 = 5
Do

  Cella = Foglio2.Cells(Cont1, 1)
  If Len(Cella) = 0 Then
    FineDomande = True
   
  Else
    IndiceDomanda.Indice(Cont1 - 5) = Cella
    Cella = Foglio2.Cells(Cont1, 2)
    IndiceDomanda.Numero(Cont1 - 5) = CInt(Cella)
   
    Cont1 = Cont1 + 1
    ReDim Preserve IndiceDomanda.Indice(UBound(IndiceDomanda.Indice) + 1)
    ReDim Preserve IndiceDomanda.Numero(UBound(IndiceDomanda.Numero) + 1)
     
  End If
Loop Until FineDomande = True

If (UBound(IndiceDomanda.Indice) > 0) Then
  ReDim Preserve IndiceDomanda.Indice(UBound(IndiceDomanda.Indice) - 1)
  ReDim Preserve IndiceDomanda.Numero(UBound(IndiceDomanda.Numero) - 1)

End If
End Sub
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Sponsor
 

Re: Help VBA

Postdi ahidai » 07/01/12 08:32

Non c'è nessuno che può darmi una mano?
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Help VBA

Postdi Flash30005 » 07/01/12 11:07

Io te l'ho data: ho messo tutto quel codice all'interno della funzione "Code"
altrimenti era ancora più incomprensibile.
E' opportuno usare le funzione dell'editor URL, Img, Code, Quote etc.


Per quanto riguarda il tuo problema penso che tu debba, come minimo, inviare il file con le spiegazioni di cosa vorresti ottenere direttamente sul foglio.

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Help VBA

Postdi ahidai » 07/01/12 11:49

Flash30005 ha scritto:Io te l'ho data: ho messo tutto quel codice all'interno della funzione "Code"
altrimenti era ancora più incomprensibile.
E' opportuno usare le funzione dell'editor URL, Img, Code, Quote etc.


Per quanto riguarda il tuo problema penso che tu debba, come minimo, inviare il file con le spiegazioni di cosa vorresti ottenere direttamente sul foglio.

Ciao

Grazie per la risposta Flash, scusami se ho sbagliato a mettere il codice nella funzione "code".
Comunque quello che mi interessava di questo file http://www.filedropper.com/quiz_4 è di implementarlo con 5 risposte invece di 4 com'è attualmente.
Spero di essere stato chiaro e grazie ancora per la tua disponibilità.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Help VBA

Postdi Flash30005 » 07/01/12 14:14

Prova questo file modificato

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Help VBA

Postdi ahidai » 07/01/12 14:56

Flash30005 ha scritto:Prova questo file modificato

Ciao

E' perfetto Flash, sembra che vada bene, anzi benissimo.
Solo una curiosità, cosa hai modificato? Ci avevo provato anche io ma con scarsi risultati....Con l'userform ci ero riuscito, ma con il codice non ci ho capito niente.....
Comunque grazie di nuovo per la tua disponibilità.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Help VBA

Postdi Flash30005 » 07/01/12 17:31

C'erano diversi punti da modificare
tutti quelli relativi a OptRispostn
aggiungere un modulo nel Case Else con aggiunta nei precedenti l'evidenziazione del rosso
la pulizia del colore nell'apposita macro
Inoltre andrebbe modificata (cosa che non ho fatto) il codice nel modulo
Codice: Seleziona tutto
Sub Inizio()
'
' Inizio
'    Application.Run "'QUIZ_1.xls'!Quiz"  '<<<<< esistente da cancellare o commentare

    Application.Run ThisWorkbook.Name & "!Quiz"  '<<<< con questa riga oppure con
'Call Quiz
End Sub


altrimenti la macro o va in errore oppure prenderà sempre il form del file con nome precedente

Ho notato che con l'opzione sequenziale una delle due frecce (domanda successiva: verso destra) non funziona
e ho trovato una riga, a parere mio errata, che ti indico qui
Codice: Seleziona tutto
'--------------------
'Procedure e funzioni
'--------------------

Private Sub AggiornaCombo()
Dim Lettere As String * 2
Dim Numeri As String
Dim Cont1 As Integer
Dim Cont2 As Integer


Lettere = Mid$(LblNumDomanda.Caption, 1&, 2&)
Numeri = Mid$(LblNumDomanda.Caption, 3&)

For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  If Lettere = IndiceDomanda.Indice(Cont1) Then
    CmbNumero.Clear
    For Cont2 = 1 To IndiceDomanda.Numero(Cont1)
      CmbNumero.AddItem Format$(Cont2, "00000")
    Next Cont2
    CmbIndice.ListIndex = Cont1
    CmbNumero.ListIndex = CInt(Numeri) '- 1  '<<<<<<<<<<<<<<<<<<< togliere -1 (io l'ho commentato)
  End If
Next Cont1

End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Help VBA

Postdi ahidai » 07/01/12 20:29

Flash30005 ha scritto:Ho notato che con l'opzione sequenziale una delle due frecce (domanda successiva: verso destra) non funziona
e ho trovato una riga, a parere mio errata, che ti indico qui
Codice: Seleziona tutto
'--------------------
'Procedure e funzioni
'--------------------

Private Sub AggiornaCombo()
Dim Lettere As String * 2
Dim Numeri As String
Dim Cont1 As Integer
Dim Cont2 As Integer


Lettere = Mid$(LblNumDomanda.Caption, 1&, 2&)
Numeri = Mid$(LblNumDomanda.Caption, 3&)

For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  If Lettere = IndiceDomanda.Indice(Cont1) Then
    CmbNumero.Clear
    For Cont2 = 1 To IndiceDomanda.Numero(Cont1)
      CmbNumero.AddItem Format$(Cont2, "00000")
    Next Cont2
    CmbIndice.ListIndex = Cont1
    CmbNumero.ListIndex = CInt(Numeri) '- 1  '<<<<<<<<<<<<<<<<<<< togliere -1 (io l'ho commentato)
  End If
Next Cont1

End Sub


Ciao

Grazie Flash, credo di aver capito dove sbagliavo, comunque a proposito delle due frecce, ho notato che mettendo casuale la freccia di sinistra funziona solo una volta. Per cortesia puoi darci un'occhiata?
Ti ringrazio per l'ennesima volta.
Ciao
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Help VBA

Postdi Flash30005 » 08/01/12 00:46

Non capisco cosa possa servire un "casuale" indietro :?: :eeh:
Più che modificare la macro per ripristinare questo "funzionamento" nasconderei proprio la freccia a sinistra in caso di opzione casuale e la ripristinerei in caso di sequenziale. :)

In ogni caso eseguo la modifica richiesta:
nel modulo inserisci la riga Public per la variabile Cas

Codice: Seleziona tutto
Public Cas as integer


Poi in questo mdulo Freccia destra inserisci la variabile Cas in questa maniera
Codice: Seleziona tutto
Private Sub CmdAvanti_Click()
Dim NumeroCasuale As Integer
Dim StrTemp As String * 1

If OptSequenziale.Value = True Then
Cas = 0         '<<<<<<<<<<<<<<<<<<<<<<<<<< azzera se Sequenziale
  If RigaDomanda < DomandeTotali Then
    RigaDomanda = RigaDomanda + 1
    Call LeggiDomanda(RigaDomanda)
    Call AzzeraOpzioni
  End If
ElseIf OptCasuale.Value = True Then
Cas = -1      '<<<<<<<<<<<<<<<<<<<<<<<<<< imposta a -1 se Casuale
  Me.MousePointer = 13


Nella macro precedentemente modificata
Codice: Seleziona tutto
'--------------------
'Procedure e funzioni
'--------------------

Private Sub AggiornaCombo()
Dim Lettere As String * 2
Dim Numeri As String
Dim Cont1 As Integer
Dim Cont2 As Integer


Lettere = Mid$(LblNumDomanda.Caption, 1&, 2&)
Numeri = Mid$(LblNumDomanda.Caption, 3&)

For Cont1 = 0 To UBound(IndiceDomanda.Indice)
  If Lettere = IndiceDomanda.Indice(Cont1) Then
    CmbNumero.Clear
    For Cont2 = 1 To IndiceDomanda.Numero(Cont1)
      CmbNumero.AddItem Format$(Cont2, "00000")
    Next Cont2
    CmbIndice.ListIndex = Cont1
    CmbNumero.ListIndex = CInt(Numeri) - Cas   '<<<<< inserire la variabile Cas (= -1)
  End If
Next Cont1

End Sub


In questa maniera ripristina il funzionamento del Casuale Avanti e Indietro
nonché corregge il bug del sequenziale


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Help VBA

Postdi ahidai » 08/01/12 08:44

[quote="Flash30005"]Non capisco cosa possa servire un "casuale" indietro :?: :eeh:
Più che modificare la macro per ripristinare questo "funzionamento" nasconderei proprio la freccia a sinistra in caso di opzione casuale e la ripristinerei in caso di sequenziale. :)

In ogni caso eseguo la modifica richiesta:
nel modulo inserisci la riga Public per la variabile Cas

Codice: Seleziona tutto
Public Cas as integer


Ciao Flash, grazie ancora per la pazienza che hai, in effetti pensandoci bene hai ragione, a che serve andare indietro quando si è in "casuale"? A niente!!!!!
La soluzione che hai proposto è ottima!!!! Quindi se non ti dispiace :) puoi farmi questa modifica?
Solo per capire ma la stringa "Public Cas as integer" dove va inserita?
Saluti e buona domenica.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Help VBA

Postdi Flash30005 » 08/01/12 10:55

Nel Modulo "ModQuiz"
Codice: Seleziona tutto
Public Cas As Integer  '<<<<< aggiungere

Type Domanda  '<<<<<<<<< esistente da qui in poi
  Indice() As String * 2
  Numero() As Integer
End Type

Sub Quiz()
FrmQuiz.Show
End Sub



Per nascondere la freccia sinistra
aggiungere la riga indicata in questa macro (OptCasuale)
Codice: Seleziona tutto
Private Sub OptCasuale_Click()
CmdIndietro.Visible = False  '<<<<<<<<<<< aggiungere
CmbIndice.Enabled = False
CmbNumero.Enabled = False
CmdVerificaRisposta.SetFocus
End Sub

e la riga indicata in OptSequenziale
Codice: Seleziona tutto
Private Sub OptSequenziale_Click()
CmdIndietro.Visible = True  '<<<<<<<<<< aggiungere
CmbIndice.Enabled = True
CmbNumero.Enabled = True
CmdVerificaRisposta.SetFocus
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Help VBA

Postdi ahidai » 08/01/12 13:44

Flash30005 ha scritto:Nel Modulo "ModQuiz"
Codice: Seleziona tutto
Public Cas As Integer  '<<<<< aggiungere

Type Domanda  '<<<<<<<<< esistente da qui in poi
  Indice() As String * 2
  Numero() As Integer
End Type

Sub Quiz()
FrmQuiz.Show
End Sub


Per nascondere la freccia sinistra
aggiungere la riga indicata in questa macro (OptCasuale)
Codice: Seleziona tutto
Private Sub OptCasuale_Click()
CmdIndietro.Visible = False  '<<<<<<<<<<< aggiungere
CmbIndice.Enabled = False
CmbNumero.Enabled = False
CmdVerificaRisposta.SetFocus
End Sub

e la riga indicata in OptSequenziale
Codice: Seleziona tutto
Private Sub OptSequenziale_Click()
CmdIndietro.Visible = True  '<<<<<<<<<< aggiungere
CmbIndice.Enabled = True
CmbNumero.Enabled = True
CmdVerificaRisposta.SetFocus
End Sub


Ciao


Ok tutto funziona alla perfezione, grazie Flash, ciao e buona domenica.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33


Torna a Applicazioni Office Windows

Chi c’è in linea

Visitano il forum: Marius44 e 42 ospiti