In Workbook_SheetBeforeDoubleClick will`s nicht

• In Workbook_SheetBeforeDoubleClick will`s nicht von Lorenz vom 07.12.2003 14:05:18
  • AW: In Workbook_SheetBeforeDoubleClick will`s nicht - von Ramses am 07.12.2003 14:30:36
  • Dank an Ramses! - von Lorenz K. am 07.12.2003 14:56:59

Betrifft: In Workbook_SheetBeforeDoubleClick will`s nicht
von: Lorenz
Geschrieben am: 07.12.2003 14:05:18
Hallo VBAler und Grüß Euch!

Was ist verkehrt?
Das im Anschluss hinterlegte Modul funkt in jedem Blatt in dem es steht!
Aber in "

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)" will es nicht



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim oBar As CommandBar
Dim oBtn As CommandBarButton
Dim wks As Worksheet
Dim iCol As Integer
Set wks = Worksheets("Zeit")
On Error GoTo Fehler
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 5 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(1, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(1, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 6 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(2, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(2, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 8 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(3, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(3, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 9 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(4, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(4, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 11 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(5, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(5, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 12 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(6, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(6, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 16 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(7, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(7, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 17 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(8, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(8, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
If Target.Row > 6 And Target.Row <= 89 And Target.Column = 3 Or Target.Column = 7 Or Target.Column = 10 Or Target.Column = 13 Or Target.Column = 15 Or Target.Column = 18 Then
Sheets("Zeit").Visible = xlHidden
Call DeleteCmdBar
Set oBar = Application.CommandBars.Add( _
Name:="StringInsert", _
Position:=msoBarPopup, _
MenuBar:=False, _
temporary:=True)
iCol = 1
Do Until IsEmpty(wks.Cells(9, iCol))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = wks.Cells(9, iCol).Value
.Style = msoButtonCaption
.OnAction = "GetValue"
End With
iCol = iCol + 1
Loop
CommandBars("StringInsert").ShowPopup
Sheets("Zeit").Visible = xlVeryHidden
End If
Fehler: Cancel = False
End Sub






MainBas:




Sub GetValue()

   'Zeitauswahl

   ActiveCell.Value = _

      Application.CommandBars("StringInsert") _

      .Controls(Application.Caller(1)).Caption

End Sub

Sub DeleteCmdBar()
'Zeitauswahl
On Error Resume Next
Application.CommandBars("StringInsert").Delete
On Error GoTo 0
End Sub


Grüße Lorenz K.

Betrifft: AW: In Workbook_SheetBeforeDoubleClick will`s nicht
von: Ramses
Geschrieben am: 07.12.2003 14:30:36
Hallo Lorenz

ich weiss nicht was bei dir nicht funktioniert.
Bei mir erscheint zumindest das PopUp.
Ich habe es dir mal ein wenig besser strukturiert ;-)

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim oBar As CommandBar
    Dim oBtn As CommandBarButton
    Dim wks As Worksheet
    Dim iCol As Integer
    Set wks = Worksheets("Zeit")
    On Error GoTo Fehler
If Target.Row > 6 And Target.Row <= 89 Then
    Select Case Target.Column
        Case 5, 6, 8, 9, 11, 12, 16, 17
            Sheets("Zeit").Visible = xlHidden
            Call DeleteCmdBar
            Set oBar = Application.CommandBars.Add( _
                Name:="StringInsert", _
                Position:=msoBarPopup, _
                MenuBar:=False, _
                temporary:=True)
            iCol = 1
            Do Until IsEmpty(wks.Cells(1, iCol))
                Set oBtn = oBar.Controls.Add
                    With oBtn
                        .Caption = wks.Cells(1, iCol).Value
                        .Style = msoButtonCaption
                        .OnAction = "GetValue"
                    End With
                iCol = iCol + 1
            Loop
            CommandBars("StringInsert").ShowPopup
            Sheets("Zeit").Visible = xlVeryHidden
        Case 3, 7, 10, 13, 15, 18
            Sheets("Zeit").Visible = xlHidden
            Call DeleteCmdBar
            Set oBar = Application.CommandBars.Add( _
                Name:="StringInsert", _
                Position:=msoBarPopup, _
                MenuBar:=False, _
                temporary:=True)
            iCol = 1
            Do Until IsEmpty(wks.Cells(9, iCol))
                Set oBtn = oBar.Controls.Add
                   With oBtn
                        .Caption = wks.Cells(9, iCol).Value
                        .Style = msoButtonCaption
                        .OnAction = "GetValue"
                    End With
                iCol = iCol + 1
            Loop
            CommandBars("StringInsert").ShowPopup
            Sheets("Zeit").Visible = xlVeryHidden
    End Select
End If
Fehler: Cancel = False
End Sub 

     Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Betrifft: Dank an Ramses!
von: Lorenz K.
Geschrieben am: 07.12.2003 14:56:59
Hallo Rainer!
Danke für die verbesserte Struktur des CODE`s.
funktioniert Super!
PS:
Im private Sub "Workbook_SheetBeforeDoubleClick" will`s trotzdem nicht.
Ist aber wegen deiner "schmäleren" Variante des CODE nicht mehr so viel,
somit füge ich sie weiter in den betroffenen Sheets ein.

Danke u. Grüsse Lorenz