Hallo Nepumuk
Nein nein, du musst raten ;-)
Hier den Code für die erste Userform. Die Aufgabe dieser Userform ist es, die eingegebenen Daten in das Excelfile zu schreiben.
Option Explicit
'X in die Userform löeschen
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE = -&H10
Private Const WS_SYSMENU = &H80000
Private Sub UserForm_Activate()
Dim lHwnd As Long, lStyle As Long
lHwnd = FindWindow("ThunderDFrame", Me.Caption)
If lHwnd <> 0 Then
lStyle = GetWindowLong(lHwnd, GWL_STYLE)
lStyle = SetWindowLong(lHwnd, GWL_STYLE, lStyle And Not WS_SYSMENU)
DrawMenuBar lHwnd
End If
End Sub
Private Sub optConclusione1_Change()
If optConclusione1.Value = False Then
optCasaUfficio.Enabled = True
optCorrispondenza.Enabled = True
optUfficioMobiliare.Enabled = True
Else
optCasaUfficio.Enabled = False
optCorrispondenza.Enabled = False
optUfficioMobiliare.Enabled = False
End If
End Sub
Private Sub optConclusione7_Change()
If optConclusione7.Value = False Then
optCasaUfficio.Enabled = True
optCorrispondenza.Enabled = True
optUfficioMobiliare.Enabled = True
Else
optCasaUfficio.Enabled = False
optCorrispondenza.Enabled = False
optUfficioMobiliare.Enabled = False
End If
End Sub
Private Sub cmdConfermareGenerali_Click()
On Error GoTo Fehler
Cells(ActiveCell.Row, 16) = IIf(optConclusione1, "a)Modifica non firmata", "") + IIf(optConclusione2, "b)Modifica firmata", "") + IIf(optConclusione3, "c)Modifica e nuovo affare", "") + IIf(optConclusione4, "d)Nuovo affare", "") + IIf(optConclusione5, "e)Rinnovo (scadenze)", "") + IIf(optConclusione6, "f)Rinnovo e nuovo affare", "") + IIf(optConclusione7, "g)Rinnovo d'ufficio", "")
Cells(ActiveCell.Row, 23) = IIf(optCasaUfficio, "Casa/ufficio ST", "") + IIf(optCorrispondenza, "Corrispondenza", "") + IIf(optUfficioMobiliare, "Ufficio Mobiliare", "")
Cells(ActiveCell.Row, 30) = txtVecchioPremioNetto.Value
Cells(ActiveCell.Row, 33) = txtNuovoPremioNetto.Value
Cells(ActiveCell.Row, 39) = IIf(optDisdettaSI, "si nuovo", "") + IIf(optDisdettaNo, "no", "") + IIf(optDisdettaGIA, "c'è già", "") + IIf(optDisdettaTolta, "tolta", "")
Cells(ActiveCell.Row, 42) = IIf(optSiConto, "si nuovo", "") + IIf(optNoConto, "no", "") + IIf(optGiaConto, "c'è già", "")
Cells(ActiveCell.Row, 46) = IIf(optGiovaniSi, "si", "") + IIf(optGiovaniNo, "no", "")
Cells(ActiveCell.Row, 48) = IIf(optConcorrenzaSi, "si", "") + IIf(optConcorrenzaNo, "no", "")
Cells(ActiveCell.Row, 45) = IIf(optCrossSellingSi, "si", "") + IIf(optCrossSellingNo, "no", "")
Unload Me
usfDatiGenerali.Hide
Fehler:
usfDatiGenerali.Hide
End Sub
Die zweite Userform wir durch folgenden Code
'Userform Cross Seeling oeffnen
If (Target.Column = 45 And Target.Row
usfCrossSelling.Show
ElseIf (Target.Column = 45 And Target.Row
usfCrossSellingNo.Show
End If
geöffnet.
'ganzer Code
Private Sub Worksheet_change(ByVal Target As Range)
On Error GoTo Fehler
Dim intRow As Integer
intRow = Target.Row
'Userform GMOMobiCasa oeffnen wenn MobiCasa
If (Target.Column = 10 And Target.Row <= 28 And Target.Value = "b)MobiCasa") Then
usfGMOMobiCasa.Show
'Userform GMOMobiPro oeffnen wenn MobiPro
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "d)MobiPro") Then
usfGMOMobiPro.Show
'Userform GMOProtekta oeffnen wenn Protekta
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "j)Protekta") Then
usfGMOProtekta.Show
'Userform usfDatiGenerali oeffnen wenn MobiCar
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "e)MobiCar") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn MobiTour
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "f)MobiTour") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn MobiSana
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "g)MobiSana") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn MobiTech
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "h)MobiTech") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn MobiLife
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "i)MobiLife") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn Tariffa semplice
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "k)Tariffa semplice") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn Malattia colletiva
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "l)Malattia colletiva") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn Lainf/Compl. Lainf
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "m)Lainf/Compl. Lainf") Then
usfDatiGenerali.Show
'Userform usfDatiGenerali oeffnen wenn Trasporto
ElseIf (Target.Column = 10 And Target.Row <= 28 And Target.Value = "n)Trasporto") Then
usfDatiGenerali.Show
End If
'Wenn Cross Selling "no" dann Spalte 52 bis 93 verbinden
If (Target.Column = 45 And Target.Row <= 28 And Target.Value = "no") Then
Range(Cells(intRow, 52), Cells(intRow, 93)).MergeCells = True
End If
'Userform Cross Seeling oeffnen
If (Target.Column = 45 And Target.Row <= 28 And Target.Value = "si") Then
usfCrossSelling.Show
ElseIf (Target.Column = 45 And Target.Row <= 28 And Target.Value = "no") Then
usfCrossSellingNo.Show
End If
'Zelle AS 5 bis AS 28 nach aenderung sperren.
'Dim rngCell As Range
'Set Target = Intersect(Target, Range("AS5:AS28"))
'If Target Is Nothing Then Exit Sub
'Me.Unprotect ("twingo69")
'For Each rngCell In Target
'rngCell.Locked = rngCell <> ""
'Next
'Me.Protect ("twingo69")
'Speichern
If Target = Range("AI1") Then ActiveSheet.Name = Target
ActiveSheet.Name = "Settimana " & Range("AI1").Value
ActiveSheet.Range("AI1").Calculate
Fehler:
End Sub
Die zweite Userform ist:
Private Sub cboConfermare1_Click()
'Daten speichern
On Error GoTo Fehler
Dim frm As UserForm
Set frm = usfCrossSelling
Range("AZ65536").End(xlUp).Offset(1, 0).Select
With frm
If (optSi1.Value = True) Then
ActiveCell.Offset(0, 0).Value = "SI"
Else
ActiveCell.Offset(0, 0).Value = "No"
End If
If (chkMobiTest.Value = True) Then
ActiveCell.Offset(0, 1).Value = "si"
Else
ActiveCell.Offset(0, 1).Value = ""
End If
If (chkOfferta.Value = True) Then
ActiveCell.Offset(0, 2).Value = "si"
Else
ActiveCell.Offset(0, 2).Value = ""
End If
If (chkMobilifeRischio = True) Then
ActiveCell.Offset(0, 3).Value = "si"
Else
ActiveCell.Offset(0, 3).Value = ""
End If
If (chkMobilifeMista = True) Then
ActiveCell.Offset(0, 4).Value = "si"
Else
ActiveCell.Offset(0, 4).Value = ""
End If
If (chkMobilifeFondiPuri = True) Then
ActiveCell.Offset(0, 5).Value = "si"
Else
ActiveCell.Offset(0, 5).Value = ""
End If
If (chkMobiLifeLegatoFondi = True) Then
ActiveCell.Offset(0, 6).Value = "si"
Else
ActiveCell.Offset(0, 6).Value = ""
End If
If (optAffareConcluso.Value = True) Then
ActiveCell.Offset(0, 7).Value = "affare concluso"
Else
If (optNonInteressato.Value = True) Then
ActiveCell.Offset(0, 7).Value = "non interessato"
Else
If (optGiàAssicurato.Value = True) Then
ActiveCell.Offset(0, 7).Value = "già assicurato"
Else
If (optNessunFabbisogno.Value = True) Then
ActiveCell.Offset(0, 7).Value = "nessun fabbisogno"
Else
If (optTrattativeInCorso.Value = True) Then
ActiveCell.Offset(0, 7).Value = "trattative in corso"
End If
End If
End If
End If
End If
ActiveCell.Offset(0, 7).Value = txtAltro
'Protekta
If (optSi2.Value = True) Then
ActiveCell.Offset(0, 13).Value = "SI"
Else
ActiveCell.Offset(0, 13).Value = "No"
End If
If (optAffareConcluso1.Value = True) Then
ActiveCell.Offset(0, 14).Value = "affare concluso"
Else
If (optNonInteressato1.Value = True) Then
ActiveCell.Offset(0, 14).Value = "non interessato"
Else
If (optGiàAssicurato1.Value = True) Then
ActiveCell.Offset(0, 14).Value = "già assicurato"
Else
If (optTrattativeInCorso1.Value = True) Then
ActiveCell.Offset(0, 14).Value = "trattative in corso"
Else
End If
End If
End If
End If
'MobiTour
If (optSi3.Value = True) Then
ActiveCell.Offset(0, 20).Value = "SI"
Else
ActiveCell.Offset(0, 20).Value = "No"
End If
If (optAffareConcluso2.Value = True) Then
ActiveCell.Offset(0, 21).Value = "affare concluso"
Else
If (optNonInteressato2.Value = True) Then
ActiveCell.Offset(0, 21).Value = "non interessato"
Else
If (optGiàAssicurato2.Value = True) Then
ActiveCell.Offset(0, 21).Value = "già assicurato"
Else
If (optTrattativeInCorso2.Value = True) Then
ActiveCell.Offset(0, 21).Value = "trattative in corso"
Else
End If
End If
End If
End If
'Sanitas
If (optSi4.Value = True) Then
ActiveCell.Offset(0, 27).Value = "SI"
Else
ActiveCell.Offset(0, 27).Value = "No"
End If
'Altro
If (optSi5.Value = True) Then
ActiveCell.Offset(0, 28).Value = "SI"
Else
ActiveCell.Offset(0, 28).Value = "No"
End If
ActiveCell.Offset(0, 29).Value = txtCheCosa.Value
'alle Feldern leeren
.optNo1.Value = True
.optNo2.Value = True
.optNo2.Value = True
.optNo3.Value = True
.optNo4.Value = True
.optNo5.Value = True
.chkMobiTest.Value = False
.chkOfferta.Value = False
.chkMobilifeRischio = False
.chkMobilifeMista = False
.chkMobilifeFondiPuri = False
.chkMobiLifeLegatoFondi = False
.optAffareConcluso.Value = False
.optNonInteressato.Value = False
.optGiàAssicurato.Value = False
.optNessunFabbisogno.Value = False
.optTrattativeInCorso.Value = False
.optAffareConcluso1.Value = False
.optNonInteressato1.Value = False
.optGiàAssicurato1.Value = False
.optTrattativeInCorso1.Value = False
.optAffareConcluso2.Value = False
.optNonInteressato2.Value = False
.optGiàAssicurato2.Value = False
.optTrattativeInCorso2.Value = False
.txtAltro = ""
.txtCheCosa = ""
End With
'usfCrossSelling schliessen
usfCrossSelling.Hide
Fehler:
usfCrossSelling.Hide
End Sub
Gruss.
Thierry