Tópico De Funções

[hicarocastro]

Este tópico de funções é para inserir e deixar disponível algumas funções.

Podem ajudar postando uma função que você usa.

Grato

[hicarocastro]

Abrir formulário

    DoCmd.OpenForm NomeDoFormulario

Abrir Formulário em caixa tipo diálogo

    DoCmd.OpenForm NomeDoFormulario, , , , , acDialog

Abrir Formulário Oculto

    DoCmd.OpenForm NomeDoFormulario, , , , , acHidden

Imprimir Relatório

    DoCmd.OpenReport NomeDoRelatorio, acViewNormal

Visualizar relatório

    DoCmd.OpenReport NomeDoRelatorio, acViewPreview

Maximizar Janela

    DoCmd.Maximize

End Function Minimizar janela

    DoCmd.Minimize

Restaurar Janela

    DoCmd.Restore

Abrir Consulta

    DoCmd.OpenQuery NomeDaConsulta

Abrir Tabela

    DoCmd.OpenTable NomeDaTabela

Executar SQL

    DoCmd.RunSQL "suaSQL"

Retirar Avisos

    DoCmd.SetWarnings False

Colocar Avisos

    DoCmd.SetWarnings True

Executar Macro

    DoCmd.RunMacro NomeDaMacro

Ocultar Barra De Ferramentas

    DoCmd.ShowToolbar NomeDaBarra, acToolbarNo

Exibir Barra De Ferramentas

    DoCmd.ShowToolbar NomeDaBarra, acToolbarYes

Executar Aplicativo

Dim Retorno
Retorno = Shell(Caminho, vbNormalFocus)

Fechar Um outro formulário

DoCmd.Close acForm, "nome do form"
                                  |
                                  |___ Pode ser relatórios, etc

Campo Vermelho ou verde a depender do valor >0 ou <0 Na propriedade formato coloque

##0,00[Preto];- #.##0,00[Vermelho];0;"Nulo"

Mensagem de Bom dia, boa tarde ou boa noite

If Time$ >= "00:00" And Time$ < "12:00" Then
    [Campo] = "Bom Dia!"
End If
If Time$ >= "12:00" And Time$ < "18:00" Then
    [Campo] = "Boa Tarde!"
End If
If Time$ >= "18:00" And Time$ <= "23:59" Then
    [Campo] = "Boa Noite!"
End If

Mensagem ao Alterar ou Incluir Colocar no evento Ao Atualizar BeforeUpdate

Dim strMsg As String
strMsg = strMsg & "O registro foi alterado ou incuído, você deseja salvar as alterações? "
strMsg = strMsg & "Clique em sim para salvar ou não para cancelar."
If MsgBox(strMsg, vbExclamation + vbYesNo, "Salvar Registro?") = vbYes Then
'do nothing
Else
DoCmd.RunCommand acCmdUndo
      
'For Access 95, use DoMenuItem instead
'DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
End If

Registrando uma dll entre em Iniciar / Executar

regsvr32 c:\windows\system\nomearquivo.dll

Desabilitar Botão atribuido a valor

Me!nomedobotão.Enabled = Not (IsNull(Me.nome do campol))
'Este comando vai habilitar um botão se um campo não for nulo!

[hicarocastro]

Atualizar um campo em execução

me.nomedocampo.requery

[hicarocastro]

Função para contar a primeira palavra:

Function CapturaPrimeiraPalavra(expr As String)
   'Esta função retira a primeira palavra de uma expressão
    Dim Temp, P As Integer
    Temp = Trim(expr)
    P = InStr(Temp, " ")
    If P = 0 Then
        CapturaPrimeiraPalavra = Temp
    Else
        CapturaPrimeiraPalavra = Left(Temp, P - 1)
    End If
End Function

Para rodar a função coloque:

teucampo=CapturaPrimeiraPalavra(ocampodapalavra)

[hicarocastro]

Capturar Ultima Palavra

Function CapturaUltimaPalavra(expr As String)
    'Esta função retira a última palavra de uma expressão
    Dim Temp, i As Integer, P As Integer
    Temp = Trim(expr)
    P = 1
    For i = Len(Temp) To 1 Step -1
        If (Mid(Temp, i, 1)) = " " Then
            P = i + 1
            Exit For
        End If
    Next i
    If P = 1 Then
        CapturaUltimaPalavra = Temp
    Else
        CapturaUltimaPalavra = Mid(Temp, P)
    End If
End Function

Para chamar a função coloque:

teucampo=CapturaUltimaPalavra(campodapalavra)

[Patricia Nascimento]

Chamando uma função atravez de uma consulta:

Chame a fução SemAcentos passando o parametro endereço e todos os registros da tabela acentuados irão aparecer sem acentos.

SELECT SemAcentos(Endereco) AS Endereço
FROM tb_Endereco WHERE tb_Endereco.[ENDERECO] Is Not Null;

Crie a função em um modulo.

Function SemAcentos(sString As String)
Dim x As Integer
Dim sStringFinal As String

Dim letra() As String

For x = 0 To Len(sString) - 1
ReDim Preserve letra(x)
letra(x) = Mid(sString, x + 1, 1)

If Asc(letra(x)) >= 192 Then 'Acentuados tem código >=192
Select Case letra(x)
Case "ã", "á"
   letra(x) = "a"
Case "é", "ê"
   letra(x) = "e"
Case "í"
   letra(x) = "i"
Case "ó", "ô", "õ"
   letra(x) = "o"
Case "ü", "ú"
   letra(x) = "u"
Case "ç"
   letra(x) = "c"
Case Else
End Select

End If
Next x

For x = 0 To Len(sString) - 1
sStringFinal = sStringFinal + letra(x)
Next x

SemAcentos = sStringFinal
End Function

Editado Julho 14, 2009 por Jonathan Queiroz
Adcionar tag's (Jonathan)

[William.Lopes]

Pesquisar dados em um formulário

Trazer dados de acordo com as informações de uma lista:

Private Sub Campo2_AfterUpdate()
DoCmd.ApplyFilter , "[Campo1]=[Forms]![NomedoFormulario].[Campo2]"
DoCmd.Requery
End Sub

Onde Campo representa o campo da tabela que você quer buscar e Campo2 a Lista com os nomes.

[Sid_ney]

Fazer uma soma em SQL.

Dim intSoma as integer
dim Rst As DAO.Recordset

Set Rst = CurrentDb.OpenRecordset("SELECT SUM " _
& "(ValorMes1+ValorMes2+ValorMes3+ValorMes4+ValorMes5+ValorMes6+ValorMes7+ValorMes8+ValorMes9+ValorMes10+ValorMes11+ValorMes12)  " _
& " FROM tab_Moradores WHERE UnidPesqMor='1-ATIVO' AND CodMorSis=" & intNMorSisAtual & "")
intSoma = Rst(0)

 

Este programa faz uma soma dos rendimento referente a uma ano, de uma determinada pessoa, com critérios difentes.

att; Sidney

 

Editado Outubro 24, 2019 por Sid_ney