Nachfrage an Hans Herber
Eugen
hallo hans
herzlichen dank für die schnelle hilfe. habe die ganze nacht versucht das problem zu lösen. jetzt weiss wieder was mehr.
füge den code nochmals an. mit weniger ereignissen. besser so? habe ich noch andere anfängerfehler drin? wäre dankbar um eine kurze kritik.
wünsche dir noch einen schönen tag.
gruss eugenS
Option Explicit
Public strCellValueSave As String ' um ESC aus ComboBox zu ermöglichen
Private Sub cboEingabe_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
Select Case KeyCode
Case 9 'TabulatorTaste
KeyCode = 0 ' TastenCode zurücksetzen, sonst stürzt Excel ab
ActiveCell.Offset(0, 1).Activate ' Zelle rechts daneben selektieren
ActiveCell.Value = Me.cboEingabe.Value
Case 13 'EnterTaste
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = Me.cboEingabe.Value
Case 27 'EscapeTaste
KeyCode = 0 ' TastenCode zurücksetzen, sonst stürzt Excel ab
cboEingabe.Visible = False
ActiveCell.Value = strCellValueSave
Case 46
cboEingabe.Value = "" 'Delete
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
'nicht bei MehrfachSelektion
If target.Cells.Count > 1 And target.Cells.MergeCells = False Then
Me.cboEingabe.Visible = False
Exit Sub
End If
'definieren
Dim isectCboAllMacro As Range
Dim isectCboHilfsListe As Range
Dim rngCboHilfsListe As Range
Dim objWB As Object
Dim intRowCnt As Integer
Dim wks As Worksheet
Dim vRow As Variant
Dim iRow As Integer, iRowT As Integer, iRowL As Integer
'belegen
Set isectCboAllMacro = Application.Intersect(target, Range("B4:B12")) 'EingabeHilfsListe mit vorandenen Makros
Set isectCboHilfsListe = Application.Intersect(target, Range("C4:C12")) 'EingabeHilfsListe mit ListenTypen
'init
Application.EnableEvents = True
strCellValueSave = ActiveCell.Value
Me.cboEingabe.Clear
'WirkBereich und HilfsListenPosition
Set isectCboAllMacro = Application.Intersect(Range(ActiveCell.Address), Range("B4:B12")) 'Wirkbereich ComboBox mit Makro
Set isectCboHilfsListe = Application.Intersect(Range(ActiveCell.Address), Range("C4:C12")) 'Wirkbereich ComboBox mit Liste
Set rngCboHilfsListe = ActiveSheet.Range("E3:E12") 'HilfsListe
'init
Set wks = ActiveSheet
Me.cboEingabe.Clear
'verzweigen
If Not isectCboAllMacro Is Nothing Then GoTo CboAllMacro
If Not isectCboHilfsListe Is Nothing Then GoTo CboHilfsListe
GoTo ERRORHANDLER
'vorhandene Makros in Combobox einlesen
CboAllMacro:
For Each objWB In ThisWorkbook.VBProject.VBComponents
With objWB.CodeModule
For intRowCnt = 1 To .CountOfLines
If .ProcOfLine(intRowCnt, 0) > "" Then
If .ProcBodyLine(.ProcOfLine(intRowCnt, 0), 0) = intRowCnt Then
Me.cboEingabe.AddItem .ProcOfLine(intRowCnt, 0)
End If
End If
Next intRowCnt
End With
Next
GoTo WITHCOMBOBOX
'Werte aus Bereich in Combobox einlesen
CboHilfsListe:
iRowL = Cells(Rows.Count, 5).End(xlUp).Row
For iRow = 3 To 12
Me.cboEingabe.AddItem wks.Cells(iRow, 5)
'iRow = iRow + 1
msgbox iRow & " " & wks.Cells(iRow, 5)
Next iRow
GoTo WITHCOMBOBOX
WITHCOMBOBOX:
With Me.cboEingabe
.Top = target.Top - 3 ' Combobox neu positionieren
.Left = target.Left - 7
.Width = target.Width + 21 ' Größe der Userform anpassen
.Height = target.Height + 6
.Font = target.Font.Name 'Font der Zelle übernehmen und etwas grösser
.Font.Size = target.Font.Size + 0.5
.Value = ActiveCell.Value ' Combobox mit bestehendem Zellinhalt füllen
.Activate ' Combobox aktivieren
.SelStart = 0
.Visible = True
End With
Exit Sub
ERRORHANDLER:
Me.cboEingabe.Visible = False
End Sub