Olá amigos.
Continuando o artigo onde respondo ao leitor Alexandro, concluo agora a resposta às suas perguntas. Veja a pergunta enviada para nós:
Saudações, quando criei um formulário no Excel (usando VBA),
os usuários reclamaram bastante dele, pois não se tem os botões
maximizar, minimizar, não se pode usar o botão do meio do mouse (rolagem para cima e para baixo),
além de não podê-lo redimensioná-lo verticalmente, em diagonal ou horizontalmente, além
de num textbox ou combobox não se pode clicar com botão direito com uma opção para colar algo
da área de transferência (daí deve-se usar control + V).
Tem alguma propriedade de formulário que faz isso ?
Como estes detalhes podem ser feitos em um formulário do EXCEL VBA ?
Obrigado Obrigado Obrigado
Então, caríssimos leitores, o menu de contexto que é o responsável por essa solicitação do Alexandro. Esse menu é chamado com o clique do botão direito do mouse. E, infelizmente, o userform pura e simplesmente não tem suporte nativo para esta funcionalidade.
Para responder esta questão, encontrei uma alternativa implementada no site www.andypope.info e vou adaptá-la neste artigo. Vejam como ficou.
Vamos adicionar uma classe que tratará de incluir um menu de contexto dentro do controle textbox acionado pleo clique do botão direito do mouse. Esta classe acessa algumas propriedades do menu do aplicativo.
Crie um módulo de classe com o nome “CTextBox_ContextMenu”. Veja seu código:
Option Explicit
'<<<< Créditos >>>>>'
'** http://www.andypope.info/vba/uf_contextualmenu.htm **'
'........................................................'
Private Const mEDIT_CONTEXTMENU_NAME = "ajpiEditContextMenu"
Private Const mCUT_TAG = "Recortar"
Private Const mCOPY_TAG = "Copiar"
Private Const mPASTE_TAG = "Colar"
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 = "&Recortar"
.FaceId = CUT_MENUID
.Tag = mCUT_TAG
End With
With .Controls.Add(msoControlButton)
.Caption = "&Copiar"
.FaceId = COPY_MENUID
.Tag = mCOPY_TAG
End With
With .Controls.Add(msoControlButton)
.Caption = "C&olar"
.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)
' 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)
' 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
Agora, o código do UserForm1, contendo dois controles textbox (Textbox1 e Textbox2):
Option Explicit
Private m_colContextMenus As Collection
Private clsContextMenu As CTextBox_ContextMenu
Private Sub UserForm_Initialize()
On Error GoTo ErroVBA
'Define o menu de contexto
Call DefineMenuDeContexto
Erro_Exit:
Exit Sub
ErroVBA:
MsgBox Err.Description
Exit Sub
End Sub
Private Sub DefineMenuDeContexto()
Set m_colContextMenus = New Collection
'TextBox1
Set clsContextMenu = New CTextBox_ContextMenu
With clsContextMenu
Set .TBox = Me.TextBox1
Set .Parent = Me
End With
m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
'TextBox2
Set clsContextMenu = New CTextBox_ContextMenu
With clsContextMenu
Set .TBox = Me.TextBox2
Set .Parent = Me
End With
m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set m_colContextMenus = Nothing
Set clsContextMenu = Nothing
End Sub
Agora experimente clicar com o botão direito dentro da caixa de texto. Será exibido uma lista com as opções:
- Recortar;
- Copiar;
- Colar.
Então é isso pessoal,
Um abraço.
Olá obrigado pelo arquivo, no excel 2007 que uso em casa, estou tendo dificuldades para fechar o arquivo (tenho que usar o gerenciador de tarefas)
isto é normal ?
grato !
Era necessário destruir a instância da classe CTextBox_ContextMenu.
Atualizei no post.
Abraço,
Saudações, obrigado por tudo !
Felicidades !
Alexandro