General information
Category:
Database DAO/RDO/ODBC/ADO
Sorry but i have a problem again with listview, if the usrs insert only the first 2 letters of a field doesnt work. Can you help.
I'm becoming very boring....
Sorry
if you can dispend some time searching for my mistake a owe you one!
I give the code of the form tha contains the list view:
Option Explicit
Private Sub BtnEditar_Click()
LviewClientes_DblClick
End Sub
Private Sub BtnNovo_Click()
MnuNovo_click
End Sub
Private Sub Command1_Click()
MnuFechar_Click
End Sub
Private Sub Form_Load()
ModUtils.CentraFormFilha MdiMenu, Me
LviewClientes.Top = 0
LviewClientes.Left = 0
ParametrizarLviewClientes
ListarRsClientes
ModVarsGlobais.CORRER_NOVAMENTE_FORM_LOAD = True
End Sub
Private Sub Form_Activate()
Dim PrimeiroItem As ListItem
If (ModVarsGlobais.CORRER_NOVAMENTE_FORM_LOAD = True) Then
Form_Load
End If
Set PrimeiroItem = LviewClientes.GetFirstVisible
If Not (PrimeiroItem Is Nothing) Then
PrimeiroItem.EnsureVisible
PrimeiroItem.Selected = True
ModVarsGlobais.CODIGO_CLIENTE = CDbl(PrimeiroItem.Text)
Else
ModVarsGlobais.CODIGO_CLIENTE = ModVarsGlobais.CLIENTE_INDEFINIDO
DesactivaMenuPopUpListagem
End If
End Sub
Private Sub ParametrizarLviewClientes()
Dim i As Integer
Dim LviewItem As ListItem
' Configuração da Lview
With LviewClientes
.View = lvwReport
.GridLines = False
.FullRowSelect = True
.BorderStyle = ccNone
.LabelEdit = lvwManual
.SortOrder = lvwAscending
.Sorted = True
End With
' Headers das Colunas
With LviewClientes.ColumnHeaders
.Add , , " Cód", 800, lvwColumnLeft
.Add , , " Nome", 3500, lvwColumnLeft
.Add , , "Telefone ", 1300, lvwColumnRight
.Add , , "Fax ", 1300, lvwColumnRight
.Add , , "Nr.Contribuinte ", 2000, lvwColumnRight
.Add , , " Email", 4000, lvwColumnLeft
End With
End Sub
Private Sub ListarRsClientes()
Dim LviewItem As ListItem
On Error GoTo ERRO_ACESSO_RECORDSET
LviewClientes.ListItems.Clear
DtaEnvBD.rsTabClientes.Open
DtaEnvBD.rsTabClientes.MoveFirst
While Not DtaEnvBD.rsTabClientes.EOF
Set LviewItem = LviewClientes.ListItems.Add(, , DtaEnvBD.rsTabClientes.Fields("NCliente"))
LviewItem.SubItems(1) = DtaEnvBD.rsTabClientes.Fields("Nome")
If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Telefone")) Then
LviewItem.SubItems(2) = DtaEnvBD.rsTabClientes.Fields("Telefone")
Else
LviewItem.SubItems(2) = ""
End If
If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Fax")) Then
LviewItem.SubItems(3) = DtaEnvBD.rsTabClientes.Fields("Fax")
Else
LviewItem.SubItems(3) = ""
End If
If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Cont")) Then
LviewItem.SubItems(4) = DtaEnvBD.rsTabClientes.Fields("Cont")
Else
LviewItem.SubItems(4) = ""
End If
If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Mail")) Then
LviewItem.SubItems(5) = DtaEnvBD.rsTabClientes.Fields("Mail")
Else
LviewItem.SubItems(5) = ""
End If
DtaEnvBD.rsTabClientes.MoveNext
Wend
DtaEnvBD.rsTabClientes.Close
CONTINUAR_SUB:
Exit Sub
ERRO_ACESSO_RECORDSET:
Resume CONTINUAR_SUB
End Sub
Private Sub Form_Unload(Cancel As Integer)
MdiMenu.TbarMDI.Enabled = True
End Sub
Private Sub LviewClientes_DblClick()
FrmClientes.Show
End Sub
Private Sub LviewClientes_ItemClick(ByVal Item As MSComctlLib.ListItem)
ModVarsGlobais.CODIGO_CLIENTE = CDbl(Item.Text)
End Sub
Private Sub LviewClientes_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Item As ListItem
If Button = vbRightButton Then
Set Item = LviewClientes.HitTest(X, Y)
If (Item Is Nothing) Then
MnuCopiar.Enabled = False
Else
MnuCopiar.Enabled = True
LviewClientes_ItemClick Item
Item.EnsureVisible
Item.Selected = True
End If
PopupMenu MnuPopUpListagem
End If
End Sub
Private Sub LviewClientes_ColumnClick(ByVal ColumnHeader As ColumnHeader)
LviewClientes.SortKey = ColumnHeader.SubItemIndex
LviewClientes.Sorted = True
Select Case LviewClientes.SortOrder
Case lvwDescending
LviewClientes.SortOrder = lvwAscending
Case Else
LviewClientes.SortOrder = lvwDescending
End Select
End Sub
Private Sub DesactivaMenuPopUpListagem()
MnuProcurar.Enabled = False
MnuCopiar.Enabled = False
MnuFechar.Enabled = False
End Sub
'This is the part of the code where i start the search
Private Sub MnuProcurar_Click()
Dim ItemAProcurar As ListItem
Set ItemAProcurar = LviewClientes.FindItem(InputBox("Introduza o Item a Pesquisar?", "Procurar", "", Me.ScaleWidth / 3, Me.Height / 2), lvwText, , lvwPartial)
If (ItemAProcurar Is Nothing) Then
MsgBox "Item Não Encontrado!", vbInformation, "Info"
Else
ItemAProcurar.EnsureVisible
ItemAProcurar.Selected = True
LviewClientes.SetFocus
End If
End Sub
Private Sub MnuCopiar_Click()
Dim ItemAProcurar As ListItem
Dim i As Integer
Dim InfoClipBoard As String
Set ItemAProcurar = LviewClientes.FindItem(CStr(ModVarsGlobais.CODIGO_CLIENTE), lvwText)
InfoClipBoard = ItemAProcurar.Text
For i = 1 To ItemAProcurar.ListSubItems.Count
InfoClipBoard = InfoClipBoard & vbTab & ItemAProcurar.SubItems(i)
Next i
Clipboard.SetText InfoClipBoard
End Sub
Private Sub MnuFechar_Click()
Unload Me
End Sub
Private Sub MnuNovo_click()
DtaEnvBD.rsTabClientes.Open
FrmClientes.BtnAdicionar_Click
End Sub
Sorry again... ... ...
Previous
Next
Reply
View the map of this thread
View the map of this thread starting from this message only
View all messages of this thread
View all messages of this thread starting from this message only