Excel VBA: OnAction and Listview - strange behavior
My worksheet (Excel 2003) has a problem in popup button that I did. The
.OnAction calls a function "Inicia" with parameters. It almost works.
Error occurs when funcion 'Inicia' calls a public function
'FormConsulta.Pesquisa2(string arg)' to search data from a sheet and to
fill to a listview. 'Pesquisa2' has a loop that passes only one time and
listview returns only one value (not always the first item found).
If I call 'FormConsulta.Pesquisa2(string arg)' anywhere, it works plenty,
but if my menu button calls it, it returns only 01 result. Here is my
code:
My Popup menu button:
With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton,
before:=1, temporary:=True)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Inicia(" & Chr(34) &
CStr(celula) & Chr(34) & ")" 'celula = an excel Cell rightclicked (type
Variant)
'style, caption, images, etc..
End With
sub Inicia: (placed on same module)
Private Sub Inicia(Optional celula As Variant)
If IsMissing(celula) Then 'se a sub foi chamada sem clicar com o
botão direito, apenas exibe form
FormAberturaChamado.Show 'this works fine this form has a call to
FormConsulta.Pesquisa2(arg) thar works fine!!
Exit Sub
End If
'(...) problem lies down here VV
If FormConsulta.Pesquisa2(celula) > 0 Then FormConsulta.Show
'(...)
End Sub
And finally FormConsulta.Pesquisa2 code:
Public Function Pesquisa2(ByVal valor As String) As Long 'boolean
'Variáveis locais
Dim rng1 As Range, rngPesquisa As Range, linBD As Long, contEncontrado
As Long, firstAddress As String,
Dim liit As ListItem
With Me.lvConsulta 'lvConsulta is ListView
.ListItems.Clear
.ColumnHeaders.Clear
.Gridlines = True
.View = lvwReport
'headers
'(...)
.ColumnHeaders.Add , , "Nome Fantasia", Width:=150
.ColumnHeaders.Add , , "Razão Social", Width:=166
.ColumnHeaders.Add , , "Telefone", Width:=62
.ColumnHeaders.Add , , "Contato", Width:=76
'etc...
End With
contEncontrado = 0 'items found
Set rngPesquisa = Sheets(PLANBD).Range("A:A") 'range of search. It's a
sample, there are other ranges of search based on type of search
Set rng1 = rngPesquisa.Find(what:=valor, MatchCase:=False)
If Not rng1 Is Nothing Then 'found at least one item
firstAddress = rng1.Address
Do 'continue searching
linBD = rng1.Row 'actual line
Set liit = FormConsulta.lvConsulta.ListItems.Add(, ,
Sheets(PLANBD).Range("A" & linBD).Value) 'Nome Fanstasia
liit.SubItems(2) = Sheets(PLANBD).Range("D" & linBD).Value
'Razao Social col D
liit.SubItems(3) = Sheets(PLANBD).Range("G" & linBD).Value
'Telefone col G
liit.SubItems(4) = Sheets(PLANBD).Range("H" & linBD).Value
'Contato Col H
'(...)
rng1 = rngPesquisa.FindNext(rng1) 'find next item
contEncontrado = contEncontrado + 1 'add items found
Loop While Not rng1 Is Nothing And rng1.Address <> firstAddress
'MsgBox("found xxx items")
Else
Call MsgBox("Nothing found", vbExclamation + vbOKOnly)
End If
Pesquisa2 = contEncontrado 'returns number of items found
End Function
Here is Do Loop While that passes only one time when I click on my menu
button. However it works fine when I call it from another Form.
Debug does not work, except if I call 'Pesquisa2' from another Form.
Anyone can help me? thanx in advance
No comments:
Post a Comment