[Resolvido]Criar Módulos de Classe

Bom dia a todos,
estou apanhando feio aqui para criar algo para simplificar minha vida e a do programa Projeto 2013, minha intensão é criar um banco de dados auto projetável, que pessoas leigas consigam programar mais fácil, até para nós mesmo facilitando nossas vidas!

O que eu pretendo é colocar o nome de todas as subformulários presente no formulário onde chamamos a função então fazer códigos auto compreensivo que tornaria minha vida tão simples para programar, mas a questão é como devo proceder para que eu realize algo assim?

Este exemplo pode não ter nada haver com a história! mas é para os programadores entender a minha situação...

Código:


Public Function frmX()
Set fX = Screen.ActiveForm
    Dim Frm As Form, i As Integer
Set Frm = Screen.ActiveForm
    For i = 0 To Frm.Controls.Count - 1
        If TypeOf Frm.Controls(i) Is SubForm Then
        X = "" & Frm.Controls(i).Name
        End If
        Next i
End Function

Aqui em cima deu para saber como pegar todas as subformulários do formulário desejado!
agora a questão é que tenho este exemplo no meu projeto 2013!

Código:


Private Sub Quadro_AfterUpdate()
On Error Resume Next
'Verifica o Quadro
If Quadro = 0 Then
Me.Subformulario.SourceObject = ""
Me.Subformulario.Form.RecordSource = ""
ElseIf Quadro = 1 Then
Call frmX
Me.Subformulario.SourceObject = "regOrcamento"
Me.Subformulario.Form.RecordSource = SQLX("*", "regCadastro", "NRegistro ='" & Me.NRegistro & "'")
Me.Subformulario.Form.regOrcamentoSub.Form.RecordSource = SQLX("*", "regItems", "NRegistro ='" & Me.NRegistro & "'")
Call Destrava
ElseIf Quadro = 2 Then
Me.Subformulario.SourceObject = "regRecebimento"
Me.Subformulario.Form.RecordSource = SQLX("*", "regCadastro", "NRegistro =" & Me.NRegistro)
Call Destrava
Else
Call Trava
End If
End Sub

Gostaria de reforçar algo mais simples onde todos os programas extensos que tenho simplifica-lo cada vez mais!
gostaria de chamar o frmX e em seguida aparecer uma droplist com se eu tivesse digitado isto:
Me."Lista de Subformulários (Filtrados) com a função frmX"
E depois do "ponto" surgir as seguintes opções:
-Lock = .form.Locked = True
-Unlock = .form.Locked = False
-RecordSource = .form.RecordSource
-Sub = .Form.Subformulario_do_Subformulario
-PermAdd = .Form.AllowAdditions = True/False
-PermEdit = .Form.AllowEdit = True/False
-PermDelete = .Form.AllowDelete = True/False
E Etc.. E Etc...

Como posso criar uma constante ou uma função de droplist desta maneira?
Gostaria de implementar algo como isto no meu projeto 2013 que estou disponibilizando para todos!

Abraços e agradeço aqueles que me ajudarem!

Não sei se lhe servirá, mas no repositório tem um exemplo de uma listbox que exibe todos os objetos do bd...

Podes então filtrar para o tipo de objeto a exibir, depois em uma listbox do tipo lista de valores exibir suas propriedades, extraidas no vba, adicionando-as na lista.

E ao clique da lista, alterar essa propriedade que ficará guardada em uma tabela e será invocada com o comando Dlookup..

Algo por ai.

Cumprimentos.

Boa tarde Piloto, obrigado pela ajuda!
Entendi mais ou menos o conceito, qual é o nome do tópico do repositório se você souber para ajudar, caso não saiba não precisa perder seu tempo que eu fuço aqui até achar!


o que eu estava falando era sobre isto (veja a imagem) talvez o que você me passou seja exatamente isto é que só não compreendi 100%

[Uma palavra mais compreensiva ou que da para entender é que eu queria criar uma nova biblioteca personalizada, que traga as funções para mim como desejo!]
Então quando eu chamar a função ou a constante não sei exatamente como se chama aparecer a lista das ações como no exemplo que citei no tópico.

frmX.[Droplist]

Amigão.. para isso vai funcionar um módulo de classe...
quando cria um modulo de classe com funções.. ao utilizar o mesmo ele exibe na janela do vba a lista das funções do modulo de classe criado.

Veja no site do avelino ou do Plinio Mabese sobre: Programando com classe.

Cumpimentos.

Olha so.. Crie um módulo de classe Nomeeie de ClassMsg e cole o codigo que postarei...

Em qualquer janela do vba digite: Msg.

Vai observar que exibirá as funções do módulo de classe

Option Compare Database

Private mCorpo As String
Private mBotao As Byte
Private mImagem As Variant
Private mTitulo As String
Private mSom As Variant
Private mResultado As Byte

Public Enum vbResultado
    Sim_1 = 1
    Nao_2 = 2
End Enum

Public Enum vbBotao
    OK_0 = 0
    SimNao_1 = 1
End Enum

Public Enum vbImagem
    Info_0 = 0
    Afir_1 = 1
    Conf_2 = 2
    Erro_3 = 3
End Enum

Public Enum vbSom
    Inf_0 = 0
    Afi_1 = 1
    Con_2 = 2
    Err_3 = 3
End Enum

Public Property Get corpo() As Variant
     corpo = mCorpo
End Property

Public Property Let corpo(ByVal NovoValor As Variant)
    mCorpo = NovoValor & ""
End Property

Public Property Get Botao() As vbBotao
     Botao = mBotao
End Property

Public Property Let Botao(ByVal NovoValor As vbBotao)
    mBotao = NovoValor
End Property
Public Property Get Imagem() As vbImagem
    Imagem = mImagem
End Property
Public Property Let Imagem(NovoValor As vbImagem)
    mImagem = NovoValor
End Property

Public Property Get Titulo() As Variant
    Titulo = mTitulo
End Property

Public Property Let Titulo(ByVal NovoValor As Variant)
    mTitulo = NovoValor & ""
End Property

Public Property Get Som() As vbSom
    Som = mSom
End Property

Public Property Let Som(ByVal NovoValor As vbSom)
    mSom = NovoValor
End Property
Public Property Get Resultado() As Variant
    Resultado = mResultado
End Property

Public Property Let Resultado(ByVal vNewValue As Variant)
    mResultado = vNewValue & ""
End Property

Public Function fCarregaMsg() As vbResultado
Dim Total%, j%, Carac$
Dim box$, pula$, pos() As Byte
On Error Resume Next
pula = Chr(13) & Chr(10)
'----------------------------
'Calcula número de asterístico
'-----------------------------
Total = Len(corpo & "")
nAst = 0
For j = 1 To Total
    Carac = Mid(corpo, j, 1)
    If Carac = "*" Then nAst = nAst + 1
Next j
If nAst = 0 Then
    NovaMsg = corpo
    GoTo Final
End If
ReDim pos(nAst + 1)
pos(0) = 0
For j = 1 To nAst + 1
    pos(j) = pos(j - 1) + InStr(Mid(corpo, pos(j - 1) + 1, Total), "*")
    If j = 1 Then
        box = Mid(corpo, 1, pos(j) - 1)
    Else
        If pos(j) - pos(j - 1) = 1 Then
            box = box & pula
        Else
            box = box & pula & Mid(corpo, pos(j - 1) + 1, IIf((pos(j) - pos(j - 1) - 1) > 0, (pos(j) - pos(j - 1) - 1), Total - pos(j)))
        End If
    End If
Next
If nAst = 0 Then
    NovaMsg = Mid(corpo, pos(j) + 1, Total)
Else
    NovaMsg = box
End If
Final:
DoCmd.OpenForm "frmMsg", , , , , acDialog, Botao
fCarregaMsg = Msg.Resultado
Call fLimpa
End Function

Private Function fLimpa()
On Error Resume Next
corpo = ""
Titulo = ""
Botao = 0
Imagem = 0
Som = 0
Resultado = 0
End Function

Cumprimentos.

Precisa ativar alguma referência? por que Aqui está dando.

Erro de copilação:
Era esperado: Identificador ou Expressão entre colchetes

Baixe o exemplo Telemax do Avelino no repositório que tem este módulo. Cumprimentos.

Cumprimentos.

Aprendi agorinha como chama a classe piloto,

Private Msg As New ClassMsg

Acabei de gerar um aqui só para testar!

Código:

Option Compare Database

' Module: SQLX
' DateTime: 14/12/2012 09:51:28
' Author: Dennis Henrique Toriello Miranda
' Description:
'---------------------------------------------------------------------------------------
   
Private Const cstrModule As String = "SQLX"
Private mprpUpdate As Property
Private mstrINSERT_INTO As Property
Public Property Get Update() As Property
    On Error GoTo HandleExit
   
    Set Update = mprpUpdate
HandleExit:
End Property
Public Property Set Update(rData As Property)
    On Error GoTo HandleExit
   
    Set mprpUpdate = rData
HandleExit:
End Property
Public Property Get INSERT_INTO() As String
    On Error GoTo HandleExit
   
    INSERT_INTO = mstrINSERT_INTO
HandleExit:
End Property
Public Property Let INSERT_INTO(rData As String)
    On Error GoTo HandleExit
   
    mstrINSERT_INTO = rData
HandleExit:
End Property
Public Function Updatek(Teste As String, Teste2 As String) As Variant
' Procedure: Updatek
' DateTime: 14/12/2012 09:51:28
' Author: Dennis Henrique Toriello Miranda
' Description:
'--
   
    Const cstrProcedure = "Updatek"
    On Error GoTo HandleError
   

HandleExit:
   
    Exit Function

HandleError:
    ErrorHandle Err, Erl(), cstrModule & "." & cstrProcedure
    Resume HandleExit
End Function

Eu vi que você usou alguns códigos para dar valor a propriedade, como exatamente aplico o valor na propriedade?

Pelo que eu entendi, o Get chama a função da droplist e o Let é o valor que ela recebe quando selecionado?

Amigão.. em classes ainda não me aprofundei, aconselho a ver o site do Mestre Avelino que tem todas as devidas explicações.

Cumprimentos.

Piloto já agradeço para trazer a tona um bom entendimento!
Você com o código que me envio já me mostrou que para chamar as funções deve se criar um Módulo de Classe, até então não sabia qual o procedimento tomar e nem como procurar! já foi muito eficiente na ajuda e lhe agradeço muito!!! agora vamos para os estudos!

Para ler sobre módulos clique aqui

podes observar tambem que no módulo do form se criar uma sub podes chamá-la pelo dropList


Sub Teste()
MsgBox "Teste"
End Sub


se digitar Me. exibira as funções e nela conterá a Sub teste.

Depois que conseguires exito no que está fazendo, poste no repositório, será de muita valia.

Bom Estudo.

Cumprimentos.