[Resolvido]Função do Mestre Avelino Samapio " Call fncPermissões(Me)

Boa tarde Amigos

A duvida está na imagem que anexo.

Código:

Public Function fncPermissões(nomeForm As Form)
Dim idFun As Long
On Error Resume Next
idFun = fncCapturaIdFuncao(nomeForm.Name, 102030)
If Nz(fncBloquear(idFun, Login.id, mtBloquear), True) = True Or Login.id = 0 Then
   MsgBox "Acesso bloqueado...", vbInformation, "" & DLookup("[Programa]", "Proprietario") & " " & DLookup("[Tipo]", "Proprietario")
   
   DoCmd.Close acForm, nomeForm.Name
 
   Exit Function
End If
nomeForm.AllowEdits = Nz(fncBloquear(idFun, Login.id, mtAtualizar), False)
nomeForm.AllowDeletions = Nz(fncBloquear(idFun, Login.id, mtExcluir), False)
nomeForm.AllowAdditions = Nz(fncBloquear(idFun, Login.id, mtInserir), False)
nomeForm.AllowDeletions = Nz(fncBloquear(idFun, Login.id, mtImprimir), False)
nomeForm.AllowAdditions = Nz(fncBloquear(idFun, Login.id, mtGrafico), False)


End Function

Código:

Public Function fncCapturaIdFuncao(Optional NomeObjeto As String, Optional chave As Long = 0) As Long
Dim rsFun       As DAO.Recordset
Dim strSql      As String
Static varFun   As Variant
Static K        As Long
Dim J           As Long

If chave <> 102030 Then Exit Function
On Error GoTo trataerro
If nlogoff = False Then
    '-----------------------------------------------------------------------------
    'O recordset ? passado para vari?vel varFun que ir? preservar o recordset at?
    'que o aplicativo seja fechado ou um novo login seja realizado.
    '-----------------------------------------------------------------------------
    strSql = "SELECT idfuncao, objeto FROM tblFun??es;"
    Set rsFun = CurrentDb.OpenRecordset(strSql, 4)
    rsFun.MoveLast: rsFun.MoveFirst
    K = rsFun.RecordCount
    varFun = rsFun.GetRows(K) 'passa o recordset para a vari?vel varFun
    rsFun.Close
    Set rsFun = Nothing
    Exit Function
End If
'-------------------------------------------------------------------------------------------
'Usamos os valores da tabela tblFun??es que est?o presenvados na vari?vel varFun
'Essa t?cnica evita que fa?amos viagens desnecess?rias ao back-end para se obter os valores
'direto da tabela tblFun??es
'-------------------------------------------------------------------------------------------
For J = 0 To (K - 1)
    If varFun(1, J) = NomeObjeto Then
        fncCapturaIdFuncao = varFun(0, J)
        Exit For
    End If
Next J

sair:
    Exit Function
trataerro:
    fncCapturaIdFuncao = 0
    Resume sair:

End Function

Código:

Public Function fncBloquear(Id As Long, idUsu As Long, Optional TipoPer As TipoPermissao = 7) As Boolean
Dim rsPer       As DAO.Recordset
Dim strSql      As String
Static varPer   As Variant
Static K        As Long
Dim J           As Long

On Error GoTo trataerro
If nlogoff = False Then
    '-----------------------------------------------------------------------------
    'O recordset ? passado para vari?vel varPer que ir? preservar o recordset at?
    'que o aplicativo seja fechado ou um novo login seja realizado.
    '-----------------------------------------------------------------------------
    strSql = "SELECT * FROM tblPermiss?esUsu?rios;"
    Set rsPer = CurrentDb.OpenRecordset(strSql, 4)
    rsPer.MoveLast: rsPer.MoveFirst
    K = rsPer.RecordCount
    varPer = rsPer.GetRows(K) 'passa o recordset para a vari?vel varPer
    rsPer.Close
    Set rsPer = Nothing
    Call fncCapturaIdFuncao(chave:=102030)
    Exit Function
End If

'-----------------------------------------------------------------------------------------------
'Usamos os valores da tabela tblpermiss?esUsu?rios que est?o presenvados na vari?vel varPer
'Essa t?cnica evita que fa?amos viagens desnecess?rias ao back-end para se obter os valores
'direto da tabela tblPermiss?esUsu?rios.
'-----------------------------------------------------------------------------------------------
For J = 0 To (K - 1)
    If CStr(varPer(1, J) & "-" & varPer(0, J)) = CStr(idUsu & "-" & Id) Then
        fncBloquear = varPer(TipoPer, J)
        Exit For
    End If
Next J

sair:
    Exit Function
trataerro:
    fncBloquear = True
    Resume sair:
End Function

Olá Assis,

Ainda falta as funções:

fncCapturaIdFuncao
fncBloquear

Também será necessário verificar como tem na tabela "Proprietario" para o utilizador em questão, como tem o parametro Permitir adições (AllowAdditions)
Assis, toca a por a mão na massa.

Abraço

Teixeira

Como tenho que por a tabela "Proprietario" ?


Obrigado

Olá Assis,
Teria que estar a estudar o código, talvez o Mestre Avelino possa ajudar.

No entanto vamos pensar, este código verifica as permissoes que estão guardadas numa tabela para cada utilizador que esteja ligado.
Por isso disse para verificar se o utilizador em questão tem permissoes para adicionar ou não (na tabela que guarda) que segundo me parece no código é Proprietário

Abraço

Teixeira
O Dlookup que se refere a tabela Proprietário é so para o título da MsgBox.

Olá, mas se não reunir a condição do IF continua.

Assis o melhor será montar uma base de dados funcional para se testar.

Abraço

Bom dia Teixeira

Difícil montar um exemplo, pois é muito complexo.

Vou esperar que o Mestre Avelino Sampaio passe por aqui, e deixa a sua opinião.

Obrigado

Olá Assis,

Ficamos então assim.
Fica o link do colega, que tem a explicação do funcionamento:
usandoaccess.com.br/tutoriais/video-controle-personalizado-acesso-de-usuarios.asp

Abraço

Olá Assis,

Lembrei, pode postr a origem de onde tirou o código e criar um form a similar o erro, que acha?

Abraço

Teixeira

Ops

Olá Assis,

Assim acho que não vai haver controlo "personalizado" por utilizador.
No entanto se é o que pretende, perfeito.

Abraço

Eu sei Amigo Teixeira
Mas quando descobrir o porquê volto aqui e posto.
Não vou desistir.
Abraço

Boa noite Teixeira

O controle por utilizador mantem-se.

Para os utilizadores sem autorização, os formulários com a função "Call fncPermissões(Me)" não abrem, mas para o administrador geral abrem todos.

Abraço