Listas suspensas em cascata - vba 1ª letra do item
Enviado: 09 Mai 2016 às 11:11
Bom Dia,
Tenho uma planilha com diversas listas suspensas interdependentes ou em cascata.
Ocorre que minhas listas são muito extensas (mais de 200 itens) e para facilita o seu uso gostaria de colocar um recurso que ao digitar a primeira letra no campo a lista abriria já mostrando os itens que iniciam com a letra digitada.
Como não tenho conhecimento em VBA achei na internet uma opção que solucionaria o problema, porém como em minhas listas na validação de dados, no campo fonte utilizei a formula indireto, essa vba não está funcionando. Já fiz o teste sem ter no campo fonte uma formula e a vba funciona da maneira com que preciso.
Peço que alguém possa solucionar esse problema. Segue abaixo a vba utilizada, lembrando que os dados da lista fica em uma aba separada da planilha:
Option Explicit
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'Ocultar caixa de combinação e mover a próxima célula com Enter e Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
'Nada
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets(Me.Name)
Application.EnableEvents = False
Application.ScreenUpdating = False
If Application.CutCopyMode Then
'Permite copiar e colar na planilha
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'Abrir a lista suspensa automaticamente
Me.TempCombo.DropDown
Me.TempCombo.MatchEntry = fmMatchEntryFirstLetter 'Aqui faz acontecer o que você deseja
Me.TempCombo.AutoWordSelect = False
End If
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End Sub
Tenho uma planilha com diversas listas suspensas interdependentes ou em cascata.
Ocorre que minhas listas são muito extensas (mais de 200 itens) e para facilita o seu uso gostaria de colocar um recurso que ao digitar a primeira letra no campo a lista abriria já mostrando os itens que iniciam com a letra digitada.
Como não tenho conhecimento em VBA achei na internet uma opção que solucionaria o problema, porém como em minhas listas na validação de dados, no campo fonte utilizei a formula indireto, essa vba não está funcionando. Já fiz o teste sem ter no campo fonte uma formula e a vba funciona da maneira com que preciso.
Peço que alguém possa solucionar esse problema. Segue abaixo a vba utilizada, lembrando que os dados da lista fica em uma aba separada da planilha:
Option Explicit
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'Ocultar caixa de combinação e mover a próxima célula com Enter e Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
'Nada
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets(Me.Name)
Application.EnableEvents = False
Application.ScreenUpdating = False
If Application.CutCopyMode Then
'Permite copiar e colar na planilha
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'Abrir a lista suspensa automaticamente
Me.TempCombo.DropDown
Me.TempCombo.MatchEntry = fmMatchEntryFirstLetter 'Aqui faz acontecer o que você deseja
Me.TempCombo.AutoWordSelect = False
End If
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End Sub
