Information générale
Catégorie:
Bases de données 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... ... ...
Précédent
Suivant
Répondre
Voir le fil de ce thread
Voir le fil de ce thread à partir de ce message seulement
Voir tous les messages de ce thread
Voir tous les messages de ce thread à partir de ce message seulement