dcomisso
Posts1Data de inscriçãosegunda 9 de maio de 2016StatusMembroÚltima visita 9 de maio de 2016
-
9 mai 2016 às 10:35
usuário anônimo -
23 mai 2016 às 15:32
Bom dia,
Tenho uma planilha da mesma forma que essa (listas suspensas dependentes e em cascata), porém as minhas listas são muito grandes e gostaria de permitir que ao inserir a primeira letra de um item a lista abrisse já com os itens que iniciam com essa letra que foi digitada.
Encontrei na net uma vba que resolveria o problema porém ao colocar em prática ela não funciona em virtude de minhas listas terem formulas (indireto) no campo fonte da validação de dados.
Dessa forma alguém teria alguma solução para esse problema?
Segue a vba:
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
Me.TempCombo.AutoWordSelect = False
End If
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
