Hallo Uwe
Leider funktioniert deine Lösung nicht. Dennoch danke ich Dir.
Hallo Gerd
Mit VBA habe ich so meine Mühe. Ich habe versucht deine Lösung in meinem Code einzufügen um deinen Vorschlag zu testen, leider erscheint die Fehlermeldung:
Fehler beim Kompilieren
Sub oder Function nicht definiert
Sicherlich weisst du wo der Fehler liegt.
Gruss.
Thierry
Code
Private Sub cmdConfermareGenerali_Click()
On Error GoTo Fehler
Unload Me
'Rami assicurativo
Cells(ActiveCell.Row, 4) = IIf(OptLainf, "Lainf", "") + IIf(OptMac, "Malattia collettiva", " _
") + IIf(OptMobiCar, "MobiCar", "") + IIf(OptMobiCasa, "MobiCasa", "") + IIf(OptMobiLifeProposta, "MobiLife", "") + IIf(OptMobiPro, "MobiPro", "") + IIf(OptMobiSana, "MobiSana", "") + IIf(OptMobiTech, "MobiTech", "") + IIf(OptMobiTour, "MobiTour", "") + IIf(OptProtekta, "Protekta", "") + IIf(OptTS, "Tariffa semplice", "")
'Tipo di conclusione
Cells(ActiveCell.Row, 6) = IIf(optConclusione1, "Nuovo affare", "") + IIf(optConclusione2, " _
Modifica firmata", "") + IIf(optConclusione3, "Modifica non firmata", "") + IIf(optConclusione4, "Modifica e nuovo affare", "") + IIf(optConclusione5, "Rinnovo d'ufficio", "")
'Luogo di conclusione
Cells(ActiveCell.Row, 7) = IIf(optCasaUfficio, "Dal cliente", "") + IIf(optCorrispondenza, " _
Corrispondenza", "") + IIf(optUfficioMobiliare, "Alla Mobiliare", "")
'Premio vecchio
Cells(ActiveCell.Row, 10) = txtVecchioPremioNetto.Value
'Premio nuovo
Cells(ActiveCell.Row, 11) = txtNuovoPremioNetto.Value
'Disdetta annuale
Cells(ActiveCell.Row, 13) = IIf(optDisdettaSI, "SI", "") + IIf(optDisdettaNo, "NO", "")
'Conto corrente
Cells(ActiveCell.Row, 14) = IIf(optSiConto, "SI", "") + IIf(optNoConto, "NO", "") + IIf( _
optGiaConto, "GIÀ", "")
'Dati giovani
Cells(ActiveCell.Row, 15) = IIf(optGiovaniSi, "SI", "") + IIf(optGiovaniNo, "NO", "") + IIf( _
optGiovaniGiaComunicato, "GIÀ", "")
'Dati conorrenza
Cells(ActiveCell.Row, 16) = IIf(optConcorrenzaSi, "SI", "") + IIf(optConcorrenzaNo, "NO", "" _
)
Dim i As Integer, arrConcl As Variant
arrConcl = Array(optConclusione2.Value, optConclusione3.Value, optConclusione5.Value)
'ABG MobiCar
For i = 2 To 0 Step -1
If arrOptConcl(i) = True Then Exit For
Next
i = Application.Min(1, i + 1)
Cells(ActiveCell.Row, 9) = OptMobiCar.Value * -i
Cells(ActiveCell.Row, 8) = OptMobiCar.Value * optConclusione1.Value
'Cells(ActiveCell.Row, 8) = IIf(OptMobiCar.Value = True And optConclusione1.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMobiCar.Value = True And optConclusione2.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMobiCar.Value = True And optConclusione3.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMobiCar.Value = True And optConclusione5.Value = True, 1, 0)
'ABG MobiTour
'Cells(ActiveCell.Row, 8) = IIf(OptMobiTour.Value = True And optConclusione1.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiTour.Value = True And optConclusione2.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiTour.Value = True And optConclusione3.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiTour.Value = True And optConclusione5.Value = True, 1, 0) _
'ABG MAC
'Cells(ActiveCell.Row, 8) = IIf(OptMac.Value = True And optConclusione1.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMac.Value = True And optConclusione2.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMac.Value = True And optConclusione3.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMac.Value = True And optConclusione5.Value = True, 1, 0)
'ABG Lainf
'Cells(ActiveCell.Row, 8) = IIf(OptLainf.Value = True And optConclusione1.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptLainf.Value = True And optConclusione2.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptLainf.Value = True And optConclusione3.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptLainf.Value = True And optConclusione5.Value = True, 1, 0)
'ABG MobiSana
'Cells(ActiveCell.Row, 8) = IIf(OptMobiSana.Value = True And optConclusione1.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiSana.Value = True And optConclusione2.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiSana.Value = True And optConclusione3.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiSana.Value = True And optConclusione5.Value = True, 1, 0) _
'ABG MobiLife
'Cells(ActiveCell.Row, 8) = IIf(OptMobiLifeProposta.Value = True And optConclusione1.Value = _
True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptMobiLifeProposta.Value = True And optConclusione2.Value = _
True, 1, 0)
'ABG TS
'Cells(ActiveCell.Row, 8) = IIf(OptTS.Value = True And optConclusione1.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptTS.Value = True And optConclusione2.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptTS.Value = True And optConclusione3.Value = True, 1, 0)
'Cells(ActiveCell.Row, 9) = IIf(OptTS.Value = True And optConclusione5.Value = True, 1, 0)
'If optConclusione4.Value = True Then
'Cells(ActiveCell.Row, 8) = 1
'Cells(ActiveCell.Row, 9) = 1
'End If
'ABG MobiTech
'Cells(ActiveCell.Row, 8) = IIf(OptMobiTech.Value = True And optConclusione1.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiTech.Value = True And optConclusione2.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiTech.Value = True And optConclusione3.Value = True, 1, 0) _
'Cells(ActiveCell.Row, 9) = IIf(OptMobiTech.Value = True And optConclusione5.Value = True, 1, 0) _
'0effnen Userform MobiCasa und MobiPro
If OptMobiCasa = False And OptMobiPro = False Then
Range("A65536").End(xlUp).Offset(1, 0).Select
ElseIf OptMobiCasa = True Then
usfGMOMobiCasa.Show
ElseIf OptMobiPro = True Then
usfGMOMobiPro.Show
Else
Range("A65536").End(xlUp).Offset(1, 0).Select
End If
Exit Sub
Fehler:
Unload Me
End Sub