Esta boa pergunta foi postada pelo Ira_boy no Fórum Access (http://forumaccess.com/eve/forums?a=tpc&s=92260328&f=273606921&m=4321067051&r=6791048051#6791048051):
"Estou com um dilema...
Existe a possibilidade de criar formulario continuo sem uma tabela ou consulta de origem ?
Explico.
Tenho o frm_principal e dentro dele dois subformularios um não acoplado e outro com origem de dados a uma consulta.
No primeiro sub eu atualizo os dados na tabela somente no final de todo o tramite, porém no sub2 eu não consigo fazer isso pq eu baseio o sub formulario em uma consulta e qdo eu digito ao passar para o campo de baixo automaticamente é salvo o registro...
Qual é a melhor forma de implantar uma transação tendo em vista essa situação.
Pois qdo alguém finalizar antes de efetivar algum procedimento fico com dados inconsistentes na tabela.
Já pensei em usar consulta exclusão porém gostaria de aprender a utilizar metodos de transação. "
Uma vez que os formulários do Access (a partir da versão 2000) têm a propriedade Recordset, é possível sim abrir uma transação, editar registros do subform (folha de dados, por exemplo), e ter um botão para salvar (Commit) e outro para desfazer as alterações (Rollback), mesmo que o usuário tenha mexido em vários registros diferentes.
Neste código de exemplo, há um formulário principal (TeuForm), um subform folha de dados (TeuSubform), e três botões no form principal: cmdEditar, cmdSalvar e cmdDesfazer.
Posso editar vários registros do subform e só salvar quando clicar no "Salvar", ou desfazer todas as alterações. Há um exemplo anexo (link no final do artigo).
Option Compare Database
Option Explicit
Private Wks As DAO.Workspace
Private blnIsTrans As Boolean
Private Sub Form_Open(Cancel As Integer)
Dim rst As DAO.Recordset
Set Wks = DBEngine.Workspaces(0)
Set rst = Wks.Databases(0).OpenRecordset("SELECT * FROM Table1")
Set Me.TeuSubform.Form.Recordset = rst
Wks.BeginTrans
blnIsTrans = True
Call BloqueiaDesbloqueiaSubform
End Sub
Private Sub cmdEditar_Click()
If blnIsTrans = False Then
Wks.BeginTrans
blnIsTrans = True
Call BloqueiaDesbloqueiaSubform
End If
End Sub
Private Sub cmdSalvar_Click()
If blnIsTrans = True Then
Wks.CommitTrans
blnIsTrans = False
Call BloqueiaDesbloqueiaSubform
End If
End Sub
Private Sub cmdDesfazer_Click()
If blnIsTrans = True Then
Wks.Rollback
blnIsTrans = False
Call BloqueiaDesbloqueiaSubform
End If
End Sub
Private Sub Form_Close()
If blnIsTrans = True Then
If MsgBox("Deseja salvar as alterações?", vbYesNo) = vbYes Then
Wks.CommitTrans
Else
Wks.Rollback
End If
End If
blnIsTrans = False
Set Wks = Nothing
End Sub
Sub BloqueiaDesbloqueiaSubform()
'Bloqueia ou desbloqueia os registros do subform
Me.TeuSubform.Form.AllowAdditions = blnIsTrans
Me.TeuSubform.Form.AllowEdits = blnIsTrans
Me.TeuSubform.Form.AllowDeletions = blnIsTrans
End Sub
A Inputbox é a função mais prática para se capturar uma entrada do usuário durante a execução do aplicativo. Seu visual pode não ser lá essas coisas, mas em termos de praticidade é imbatível: com uma ou duas linhas de código, sem necessidade de um formulário, a janela com um textbox e dois botões (OK e Cancel) é exibida ao usuário.
No excelente site http://www.xcelfiles.com há uma função personalizada no VBA, com chamada a APIs, que mostra uma Inputbox com máscara de senha (http://www.xcelfiles.com/API_09.html). A autoria é do MVP inglês Daniel Klann.
Para usar, basta colar este código em um módulo padrão e chamar a função InputboxDK:
'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003
'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////
'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) _
As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox
'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, _
Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, _
Optional Context As Long) As String
Dim lngModHwnd As Long, lngThreadID As Long
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
If Xpos Then
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If
ExitProperly:
UnhookWindowsHookEx hHook
End Function