Option Explicit
Const SW_SHOWMAXIMIZED = 3
Dim TextoDigitado As String
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As LongPtr) As LongPtr
#Else
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
#End If
Sub fncShellExecute(strPath As String)
'Abre um arquivo usando o programa padrão do Windows para sua extensão.
ShellExecute hwnd:=Application.hwnd _
, lpOperation:="open" _
, lpFile:=strPath _
, lpParameters:=vbNullString _
, lpDirectory:=VBA.Environ("SystemDrive") _
, nShowCmd:=SW_SHOWMAXIMIZED
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim lngRow As Long
With ThisWorkbook.Worksheets("base")
lngRow = fncMatch(Me.ListBox1.List(Me.ListBox1.ListIndex), .Columns("A"))
fncShellExecute .Cells(lngRow, "D")
End With
End Sub
Function fncMatch(ByVal str As String, ByVal varVetor As Variant) As Long
Dim Temp As Long
On Error Resume Next
Temp = WorksheetFunction.Match(str + 0, varVetor, 0)
If Temp = 0 Then Temp = WorksheetFunction.Match(CStr(str), varVetor, 0)
fncMatch = Temp
End Function
Private Sub txtPesquisar_Change()
TextoDigitado = txtPesquisar.Text
Call PreencheLista
End Sub
Private Sub UserForm_Initialize()
Call PreencheLista
End Sub
Private Sub PreencheLista()
Dim ws As Worksheet
Dim i As Integer
Dim TextoCelula As String
'Não se esqueça de qualificar suas planilhas com ThisWorkbook!
'Caso contrário, você obterá um erro se tentar executar o código se
'uma pasta de trabalho diferente estiver ativa.
Set ws = ThisWorkbook.Worksheets("base")
i = 1
ListBox1.Clear
With ws
While .Cells(i, 1).Value <> Empty
TextoCelula = .Cells(i, 1).Value
If VBA.UCase(VBA.Left(TextoCelula, Len(TextoDigitado))) = VBA.UCase(TextoDigitado) Then
ListBox1.AddItem .Cells(i, 1)
ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("B" & i)
ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("C" & i)
ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("D" & i)
End If
i = i + 1
Wend
End With
End Sub
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
