sexta-feira, 21 de julho de 2017
assinantes
   Assinatura Ativo Access


Não Assinantes
ConteÚdo
DOWNLOADS
Interação
dicas aleatórias
Dica #1
Ficha de sistema
Publicado: 24/01/2004

Dicas

Modulo com rotinas que facilitam o trabalho com Caixas de Listagens
Autor:  Rogerio Olimpío Lourenço de Oliveira (rogerolim@bol.com.br)
Publicado:  24/03/2005
Visitas: 4674
 
From: rogerio
To: ativoaccess@ativoaccess.com.br
Sent: Wednesday, March 23, 2005 6:19 PM
Subject: Colaboração ao ativo access


Acredito que entraria na seção Dicas/Exemplos:

Nome completo do autor: Rogerio Olimpío Lourenço de Oliveira
E-mail para contato: rogerolim@bol.com.br
Breve descrição do artigo: Modulo com rotinas que facilitam o trabalho com Caixas de Listagens.

Abraços


Rogerio Olimpio L. Oliveira
Point Systems S/C Ltda
Rua Barão do Triunfo, 520 - 10.o andar - São Paulo - SP
(11) 5535-1590
www.pointsystems.com.br

============================================================

Attribute VB_Name = "Mod_ListBOX"
'---------------------------------------------------------------------------------------
' Module : Mod_ListBOX
' Data : 23/3/2005 18:12
' Autor : rogerio
' Proposito : Rotinas para uso em caixas de listagem
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : SomaColLista
' DateTime : 23/3/2005 17:56
' Autor : rogerio
' Proposito : Soma os valores de uma coluna de listbox
'---------------------------------------------------------------------------------------
'
Function SomaColLista(Quallista As ListBox, Optional QualCol As Integer) As Double
Dim Var As Variant
Dim tmp As Double

For Var = 0 To Quallista.ListCount - 1
If IsNumeric(Quallista.Column(QualCol, Var)) Then
tmp = tmp + Quallista.Column(QualCol, Var)
End If
Next Var
SomaColLista = tmp
End Function


'---------------------------------------------------------------------------------------
' Procedure : ItemsSelecionadosLista
' DateTime : 23/3/2005 17:54
' Autor : rogerio
' Proposito : Lista todos/so selecionados items da caixa em uma string separados
' por um caractere separador
'---------------------------------------------------------------------------------------
'
Function ItemsSelecionadosLista(Ctl As ListBox, _
Optional SoItemSelecionado As Boolean = True, _
Optional Separador As String = ", ") As String
Dim Var As Variant
Dim tmp As String

If SoItemSelecionado Then
For Each Var In Ctl.ItemsSelected
tmp = tmp & Ctl.ItemData(Var) & Separador
Next Var
Else
For Var = 0 To Ctl.ListCount - 1
tmp = tmp & Ctl.ItemData(Var) & Separador
Next Var
End If

If Len(tmp) > 0 Then
ItemsSelecionadosLista = Left(tmp, Len(tmp) - 1)
End If
End Function


'---------------------------------------------------------------------------------------
' Procedure : ListaItemsCaixa
' DateTime : 7/12/2004 15:56
' Autor : rogerio
' Proposito : Lista todos os items da caixa de listagem em uma string separados
' por um Separador
'---------------------------------------------------------------------------------------
'
Function ListaItemsCaixa(Qcaixa As ListBox, Optional Separador As String = ", ") As String
Dim Var As Variant
Dim tmp As String
For Each Var In Qcaixa.ItemsSelected
tmp = tmp & Qcaixa.ItemData(Var) & Separador
Next Var
If tmp = "" Then
ListaItemsCaixa = ""
Else
ListaItemsCaixa = Left(tmp, Len(tmp) - Len(Separador))
End If
End Function

'---------------------------------------------------------------------------------------
' Procedure : SelecionaItemsCaixa
' DateTime : 7/12/2004 15:58
' Autor : rogerio
' Proposito : Seleciona todos os items
'---------------------------------------------------------------------------------------
'
Sub SelecionaItemsCaixa(Qcaixa As ListBox)
Dim Var As Variant

If Qcaixa.ItemsSelected.Count > 0 Then
For Each Var In Qcaixa.ItemsSelected
Qcaixa.Selected(Var) = False
Next Var
End If

For Var = 0 To Qcaixa.ListCount - 1
Qcaixa.Selected(Var) = True
Next Var

End Sub


'---------------------------------------------------------------------------------------
' Procedure : DeselecionaItemsCaixa
' DateTime : 7/12/2004 15:59
' Autor : rogerio
' Proposito : De-seleciona todos os
'---------------------------------------------------------------------------------------
'
Sub DeselecionaItemsCaixa(Qcaixa As ListBox)
Dim Var As Variant

For Each Var In Qcaixa.ItemsSelected
Qcaixa.Selected(Var) = False
Next Var

End Sub

'---------------------------------------------------------------------------------------
' Procedure : ItemEstaNaLista
' DateTime : 7/12/2004 15:58
' Autor : rogerio
' Proposito : Verifica se um item ja esta na caixa de Listagem
'---------------------------------------------------------------------------------------
'
Function ItemEstaNaLista(Qcaixa As ListBox, QualItem As Variant, _
Optional QualCol As Integer = -1) As Boolean
Dim Var As Variant

If Qcaixa.ListCount = 0 Then
Exit Function
End If

If QualCol = -1 Then QualCol = Qcaixa.BoundColumn

For Var = 0 To Qcaixa.ListCount - 1
If Qcaixa.Column(QualCol, Var) = QualItem Then
ItemEstaNaLista = True
Exit Function
End If
Next Var

End Function

  « Voltar

 

Assine AtivoAccess
     CD Ativo Access = R$ 44,70

 

   Copyright © Ativo Access 2003 - 2017- Todos os direitos reservados   Política de Privacidade | Fale conosco