Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Tastensperre | Herbers Excel-Forum


Betrifft: Tastensperre von: Lorenz
Geschrieben am: 06.01.2010 12:59:34

Hallo Excelianer

Gibt es eine Möglichkeit wenn z.B. eine der 4 Richtungstasten öfter als zwei Mal infolge betätigt wurden, ein Makro in (Workbook_SheetSelectionChange) nicht od. nicht mehr ausgeführt wird?.

Hat vielleicht jemand nen TIPP?.

Danke im voraus & Grüße
Lorenz

  

Betrifft: AW: Tastensperre von: Daniel
Geschrieben am: 06.01.2010 13:51:13

Hi

probier mal das Makro.
dein eigenes SelectionChange-Makro musst du and der bezeichneten Stelle einbauen:

Option Explicit

Dim Sel1 As Range
Dim Sel2 As Range
Dim Sel3 As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Check As Boolean
Dim i As Long
Dim CheckR As Boolean
Dim CheckC As Boolean
Dim R(3) As Long, C(3) As Long

If Target.Cells.Count > 1 Then
ElseIf Sel1 Is Nothing Then
ElseIf Sel2 Is Nothing Then
ElseIf Sel3 Is Nothing Then
Else
    R(0) = ActiveCell.Row: C(0) = ActiveCell.Column
    R(1) = Sel1.Row: C(1) = Sel1.Column
    R(2) = Sel2.Row: C(2) = Sel2.Column
    R(3) = Sel3.Row: C(3) = Sel3.Column
    
    
    If (Abs(R(0) - R(3)) = 3 And Abs(R(0) - R(2)) = 2 And Abs(R(0) - R(1)) = 1 _
                And C(0) = C(1) And C(0) = C(2) And C(0) = C(3)) Or _
       (Abs(C(0) - C(3)) = 3 And Abs(C(0) - C(2)) = 2 And Abs(C(0) - C(1)) = 1 _
                And R(0) = R(1) And R(0) = R(2) And R(0) = R(3)) Then
            Check = True
    End If
    
End If
            
If Not Check Then
    MsgBox "Hier sollte jetzt dein Makro stehen"
End If

Set Sel3 = Sel2
Set Sel2 = Sel1
Set Sel1 = ActiveCell

End Sub
Gruß, Daniel


  

Betrifft: AW: Tastensperre von: Lorenz
Geschrieben am: 06.01.2010 15:05:43

Hallo Daniel.

Vielen Dank. Dein Makro funktioniert "1A" . Aber in Kombination mit meinem Code leider nicht.

hier der Code:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If InStr(1, "1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.16.17.18.19.20.21.22.23.24.25.26.27.28.29.30. _
31.", Sh.Name) <> 0 Then
If Target.Row >= 6 And Target.Row <= 89 And Target.Column = 37 Then frmZA.Show
If wksDaten.Range("z5").Value = 1 Then
If Target.Cells.Count > 1 Then
ElseIf Sel1 Is Nothing Then
ElseIf Sel2 Is Nothing Then
ElseIf Sel3 Is Nothing Then
Else
    R(0) = ActiveCell.Row: C(0) = ActiveCell.Column
    R(1) = Sel1.Row: C(1) = Sel1.Column
    R(2) = Sel2.Row: C(2) = Sel2.Column
    R(3) = Sel3.Row: C(3) = Sel3.Column
    
    If (Abs(R(0) - R(3)) = 3 And Abs(R(0) - R(2)) = 2 And Abs(R(0) - R(1)) = 1 And C(0) = C(1)  _
And C(0) = C(2) And C(0) = C(3)) Or _
       (Abs(C(0) - C(3)) = 3 And Abs(C(0) - C(2)) = 2 And Abs(C(0) - C(1)) = 1 And R(0) = R(1)  _
And R(0) = R(2) And R(0) = R(3)) Then
            Check = True
    End If
  
End If
            
If Not Check Then
With ActiveSheet.TxtInfo
 If Not Intersect(Target, Range("A6:A89")) Is Nothing Then
 Select Case wksDaten.Cells(Target.Row, 30)
 Case Is = "C5"
 sArtVerwend = " - Obermeister"
 Case Is = "C3", "C4"
 sArtVerwend = " - Meister"
 Case Is = "AO"
 sArtVerwend = " - Aufsichtsorgan"
 Case Is = "SM"
 sArtVerwend = " - selbstständiger Monteur"
 Case Is = "Ptf"
 sArtVerwend = " - Partieführer"
 Case Is = "FA"
 sArtVerwend = " - Facharbeiter"
 Case Is = "FaH"
 sArtVerwend = " - Facharbeiter-Helfer"
 Case Is = "AA"
 sArtVerwend = " - angelernter Arbeiter"
 Case Is = "KV"
 sArtVerwend = " - Kollektivvertragler"
 Case Is = "Mau"
 sArtVerwend = " - Maurer"
 Case Is = "Pfl"
 sArtVerwend = " - Pflasterer"
 Case Is = "Zimm"
 sArtVerwend = " - Zimmerer"
 Case Is = "Schreiber"
 sArtVerwend = " - Kanzleischreiber"
 Case Is = "Mau"
 sArtVerwend = " - Maurer"
 End Select
        .Height = 27.5
        .AutoSize = True
        .Visible = True
        .Top = Target.Offset(2, 0).Top
        .Left = Target.Left
            If Target.Value = "" Then .Visible = False
                If Target <> "" Then
                .Text = wksDaten.Cells(Target.Row, 29) & "     Schema " & wksDaten.Cells(Target. _
Row, 32) & "/" & wksDaten.Cells(Target.Row, 31) & sArtVerwend
                End If
  Else
        .Visible = False
        .Top = Cells(5, 5).Top
        .Left = Cells(5, 5).Left
  End If
End With
 
With ActiveSheet.TxtName
If Not Intersect(Target, Range("B6:BD89")) Is Nothing Then
.Height = 27.5
.AutoSize = True
.Visible = True
.Top = Target.Offset(2, 0).Top
.Left = Target.Left
    If Target = "" Then
    .Text = UCase(wksDaten.Cells(Target.Row, 27)) & " - [" & Cells(5, Target.Column).Text & "]"
    .BackColor = &H4000&
    End If
        If Target <> "" Then
        .Text = UCase(Cells(Target.Row, 1)) & " " & wksT32.Cells(99, Target.Column) & " " &  _
Target.Text & " " & wksT32.Cells(100, Target.Column)
        .BackColor = &H80&
        End If
Else
        .Visible = False
        .Top = Cells(5, 10).Top
        .Left = Cells(5, 10).Left
End If
End With
        
With ActiveSheet.TxtStatist
If Not Intersect(Target, Union(Range("BE6:CZ89"), Range("EW6:FL89"), Range("GR6:HW89"))) Is  _
Nothing Then
.Height = 27.5
.AutoSize = True
    If Target.Value = "" Then
    .Visible = False
    Else
    .Visible = True
    End If
    .Top = Target.Offset(2, 0).Top
    .Left = Target.Left
        If Target <> "" Then
        .Text = UCase(wksDaten.Cells(Target.Row, 27)) & " bei " & wksT1.Cells(90, Target.Column) _
 & " " & Target.Text & " " & Cells(5, Target.Column).Text
        .BackColor = &H80&
        End If
        Else
        .Visible = False
        .Top = Cells(5, 15).Top
        .Left = Cells(5, 15).Left
        End If
        End With
    End If
End If

End If
Set Sel3 = Sel2
Set Sel2 = Sel1
Set Sel1 = ActiveCell
End Sub
Kannst du vielleicht erkennen woran es scheitert?
PS.: Die Txt.... sind Textboxen in den Sheets!

Grüße Lorenz


  

Betrifft: AW: Tastensperre von: Daniel
Geschrieben am: 06.01.2010 15:46:46

HI

da müsste ich schon die Datei haben um das zu testen.
setz mal am anfang des Makros einen Haltepunkt und ge im Einzelstepmodus durch.
vielleicht erkennst du dann, wo das Problem ist.

Gruß, Daniel