엑셀 VBA 사용자 정의 폼 상황에 맞는 메뉴 클래스 코드

Question

이미지에 적용되는 엑셀 사용자 양식 내에서 상황에 맞는 메뉴 만들기 ...

나는 나를에서 생성 된 상황에 맞는 메뉴를 사용할 수 있도록 VBA 코드의 조각을 쓰기 위해 노력하고 있어요 Excel 사용자 양식에서 Image을 마우스 오른쪽 버튼으로 클릭합니다.

Andy Pope은 Excel 사용자 양식 내의 텍스트 상자에 적용되는 간단한 컨텍스트 메뉴를 추가하기 위해 친절하게도 세계에 많은 코드를 제공했지만 Userform.Image 태그는 사용할 수 없습니다.

http://www.andypope.info/vba/uf_contextualmenu.htm

나는 Locked = True 텍스트 상자의 상황에 맞는 사용을 방지하기 위해 지금까지 약간 자신의 코드를 편집했습니다.

'Copyright ©2007-2014 Andy Pope 
Option Explicit 

Private Const mEDIT_CONTEXTMENU_NAME = "ajpiEditContextMenu" 
Private Const mCUT_TAG = "CUT" 
Private Const mCOPY_TAG = "COPY" 
Private Const mPASTE_TAG = "PASTE" 

Private m_cbrContextMenu As CommandBar 
Private WithEvents m_txtTBox As MSForms.TextBox 
Private WithEvents m_cbtCut As CommandBarButton 
Private WithEvents m_cbtCopy As CommandBarButton 
Private WithEvents m_cbtPaste As CommandBarButton 
Private m_objDataObject As DataObject 
Private m_objParent As Object 
Private Function m_CreateEditContextMenu() As CommandBar 
' 
' Build Context menu controls. 
' 
    Dim cbrTemp As CommandBar 
    Const CUT_MENUID = 21 
    Const COPY_MENUID = 19 
    Const PASTE_MENUID = 22 

    Set cbrTemp = Application.CommandBars.Add(mEDIT_CONTEXTMENU_NAME, Position:=msoBarPopup) 
    With cbrTemp 
     With .Controls.Add(msoControlButton) 
      .Caption = "Cu&t" 
      .FaceId = CUT_MENUID 
      .Tag = mCUT_TAG 
     End With 
     With .Controls.Add(msoControlButton) 
      .Caption = "&Copy" 
      .FaceId = COPY_MENUID 
      .Tag = mCOPY_TAG 
     End With 
     With .Controls.Add(msoControlButton) 
      .Caption = "&Paste" 
      .FaceId = PASTE_MENUID 
      .Tag = mPASTE_TAG 
     End With 
    End With 

    Set m_CreateEditContextMenu = cbrTemp 

End Function 
Private Sub m_DestroyEditContextMenu() 
    On Error Resume Next 
    Application.CommandBars(mEDIT_CONTEXTMENU_NAME).Delete 
    Exit Sub 
End Sub 
Private Function m_GetEditContextMenu() As CommandBar 

    On Error Resume Next 

    Set m_GetEditContextMenu = Application.CommandBars(mEDIT_CONTEXTMENU_NAME) 
    If m_GetEditContextMenu Is Nothing Then 
     Set m_GetEditContextMenu = m_CreateEditContextMenu 
    End If 

    Exit Function 

End Function 
Private Function m_ActiveTextbox() As Boolean 
' 
' Make sure this instance is connected to active control 
' May need to drill down through container controls to 
' reach ActiveControl object 
' 
    Dim objCtl As Object 

    Set objCtl = m_objParent.ActiveControl 
    Do While UCase(TypeName(objCtl)) <> "TEXTBOX" 
     If UCase(TypeName(objCtl)) = "MULTIPAGE" Then 
      Set objCtl = objCtl.Pages(objCtl.Value).ActiveControl 
     Else 
      Set objCtl = objCtl.ActiveControl 
     End If 
    Loop 
    m_ActiveTextbox = (StrComp(objCtl.Name, m_txtTBox.Name, vbTextCompare) = 0) 

ErrActivetextbox: 
    Exit Function 

End Function 
Public Property Set Parent(RHS As Object) 
    Set m_objParent = RHS 
End Property 
Private Sub m_UseMenu() 

    Dim lngIndex As Long 

    For lngIndex = 1 To m_cbrContextMenu.Controls.Count 
     Select Case m_cbrContextMenu.Controls(lngIndex).Tag 
     Case mCUT_TAG 
      Set m_cbtCut = m_cbrContextMenu.Controls(lngIndex) 
     Case mCOPY_TAG 
      Set m_cbtCopy = m_cbrContextMenu.Controls(lngIndex) 
     Case mPASTE_TAG 
      Set m_cbtPaste = m_cbrContextMenu.Controls(lngIndex) 
     End Select 
    Next 

End Sub 
Public Property Set TBox(RHS As MSForms.TextBox) 
    Set m_txtTBox = RHS 
End Property 
Private Sub Class_Initialize() 

    Set m_objDataObject = New DataObject 
    Set m_cbrContextMenu = m_GetEditContextMenu 

    If Not m_cbrContextMenu Is Nothing Then 
     m_UseMenu 
    End If 

End Sub 
Private Sub Class_Terminate() 

    Set m_objDataObject = Nothing 
    m_DestroyEditContextMenu 

End Sub 
Private Sub m_cbtCopy_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) 

    ' check active textbox is this instance of CTextBox_ContextMenu 
    If m_ActiveTextbox() Then 
     With m_objDataObject 
      .Clear 
      .SetText m_txtTBox.SelText 
      .PutInClipboard 
     End With 
    End If 

End Sub 
Private Sub m_cbtCut_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) 
If m_txtTBox.Locked = True Then 
Exit Sub 
End If 

    ' check active textbox is this instance of CTextBox_ContextMenu 
    If m_ActiveTextbox() Then 
     With m_objDataObject 
      .Clear 
      .SetText m_txtTBox.SelText 
      .PutInClipboard 
      m_txtTBox.SelText = vbNullString 
     End With 
    End If 

End Sub 
Private Sub m_cbtPaste_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) 
If m_txtTBox.Locked = True Then 
Exit Sub 
End If 

    ' check active textbox is this instance of CTextBox_ContextMenu 
    On Error GoTo ErrPaste 

    If m_ActiveTextbox() Then 
     With m_objDataObject 
      .GetFromClipboard 
      m_txtTBox.SelText = .GetText 
     End With 
    End If 

ErrPaste: 
    Exit Sub 
End Sub 
Private Sub m_txtTBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) 

    If Button = 2 Then 
     ' right click 
     m_cbrContextMenu.ShowPopup 
    End If 

End Sub 

이미지에 적용 할 동일한 컨텍스트 메뉴에이 코드를 추가하려면 어떻게해야합니까? 의 라인을 따라 뭔가 ...

는 New Private Function

Private Function m_ActiveImage() As Boolean 
' 
' Make sure this instance is connected to active control 
' May need to drill down through container controls to 
' reach ActiveControl object 
' 
    Dim objCtl As Object 

    Set objCtl = m_objParent.ActiveControl 
    Do While UCase(TypeName(objCtl)) <> "IMAGE" 
     If UCase(TypeName(objCtl)) = "MULTIPAGE" Then 
      Set objCtl = objCtl.Pages(objCtl.Value).ActiveControl 
     Else 
      Set objCtl = objCtl.ActiveControl 
     End If 
    Loop 
    m_ActiveImage = (StrComp(objCtl.Name, m_imgImage.Name, vbTextCompare) = 0) 

ErrActiveimage: 
    Exit Function 

End Function 

나는 새로운 Public Property Set

Public Property Set Img(RHS As MSForms.Image) 
    Set m_imgImage = RHS 
End Property 

각 상황에 맞는 메뉴를 선언 할 필요가 선언 Private WithEvents m_imgImage As MSForms.Image

Private m_cbrContextMenu As CommandBar 
Private WithEvents m_txtTBox As MSForms.TextBox 

Private WithEvents m_imgImage As MSForms.Image 

Private WithEvents m_cbtCut As CommandBarButton 
Private WithEvents m_cbtCopy As CommandBarButton 
Private WithEvents m_cbtPaste As CommandBarButton 
Private m_objDataObject As DataObject 
Private m_objParent As Object 
Private Function m_CreateEditContextMenu() As CommandBar 

추가 옵션 wou 이미지를 클릭하면 사용자 권한의 가능성을 포함하도록 변경 LD 필요 ...

Private Sub m_cbtCopy_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) 

    ' check active image is this instance of CTextBox_ContextMenu 
    If m_ActiveTextbox() Then 
     With m_objDataObject 
      .Clear 
      .SetText m_txtTBox.SelText 
      .PutInClipboard 
     End With 
    End If 

    ' check active image is this instance of CImage_ContextMenu 
    If m_ActiveImage() Then 
     With m_objDataObject 
      .Clear 
      'What would be the image alternative for this next line of code? 
      '.SetText m_imgImage.SelText 
      .PutInClipboard 
     End With 
    End If 

End Sub 

당신은 내가 단지 내에서 오링 CopyCut 팅 등의 상황에 맞는 메뉴의 기능과 Paste를 사용하고 있습니다 것입니다 * 사용자 양식은 필요하지 않습니다.

그리고 마지막으로 내가 방아쇠를 다시 할 필요가 ... 그것은 불필요한 작업의 엄청 많이 보인다

Private Sub m_imgImage_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) 

    If Button = 2 Then 
     ' right click 
     m_cbrContextMenu.ShowPopup 
    End If 

End Sub 

는 쉬운 방법이 있어야합니다.

도움이나 조언이 있으면 감사 드리며 시간을내어 다시 한 번 감사드립니다.

내가 바로, 당신은 단지 하나 개의 하위에있는 모든 이미지 클릭에 응답 할 질문을 이해 한 경우 씨 J.

Answer 1

. 이것이 내가하는 방법이다. 먼저 (이 예를 들어)라는 클래스 ImageClickResponder을 만들고 다음을 추가

Option Explicit 

Private micrs() As ImageClickResponder 

Private Sub UserForm_Initialize() 
    micrs = LoadImageClickResponders(Me) 
End Sub 

Public Sub AllImgs_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) 
    Debug.Print "Your context menu code here" 
End Sub 

Private Function LoadImageClickResponders(ByRef frm As MSForms.UserForm) As ImageClickResponder() 
    Dim rtnVal() As ImageClickResponder 
    Dim ctrl As MSForms.Control 
    Dim i As Long 

    For Each ctrl In frm.Controls 
     If TypeOf ctrl Is MSForms.Image Then 
      ReDim Preserve rtnVal(i) As ImageClickResponder 
      Set rtnVal(i) = New ImageClickResponder 
      rtnVal(i).Initialize ctrl, Me, "AllImgs_MouseDown", VbMethod 
      i = i + 1 
     End If 
    Next 
    LoadImageClickResponders = rtnVal 
End Function