VBA-Access_Dicas

VBA-ACCESS

VBA-ACCESS

Configurações e Otimizações

DoCmd

Abrir Relatório
DoCmd.OpenReport “NomeRel”, acViewPreview
Abrir Relatório com filtro
DoCmd.OpenReport “NomeRel”, acViewPreview, , “CampoRel= ” & Me!CampoForm

Gerar Relatório em PDF
DoCmd.OutputTo acOutputReport, “Rel”, acFormatPDF, “c:\_Dsv\Rel.pdf”

Abrir Formulário
DoCmd.OpenForm “Nome Formuário”
Abrir Consulta
DoCmd.OpenQuery “NomeConsulta”, acNormal, acEdit

Atualizar
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Comandos
Renomear	Name NomeOrigem As NomeDestino
Copiar	FileCopy CaminhoOrigem, CaminhoDestino
Deletar	If Dir(NomeDestino) <> “” Then Kill NomeDestino End If

Eco ComandosDoCmd.SetWarnings False

Ribbon (Sim – Mostra comando no cabeçalho)
DoCmd.ShowToolbar “ribbon”, acToolbarYes
DoCmd.SelectObject acTable, , True

Ribbon (Não mostra comando no cabeçalho)
DoCmd.ShowToolbar “ribbon”, acToolbarNo
DoCmd.SelectObject acTable, , True
DoCmd.RunCommand acCmdWindowHide

Cores

Vermelho	2037680
Azul Escuro	9125192
Azul claro	16711680
Verde	5540692
Verde claro	3329330
Preto	0
Amarelo	65535
Branco	16777215

Private Sub Detalhe_Paint()
If Me.Rnk = 1 Then
Me.Rnk.ForeColor = 2037680 ‘ Vermelho
Me.Rnk.FontBold = True
Else
Me.Rnk.ForeColor = 0
Me.Rnk.FontBold = False
End If
End Sub

Aplicativos externos – (Abrir calculadora)

Private Sub Comando_Click()
Dim Calculadora As Variant
Calculadora = Shell(“C:\Windows\System32\Calc.exe”, 1)
End Sub
———————————————————-

Gerar Relatório PDF – Individual – Um arquivo para cada Agente
Function PDF_ProduçãoDiáriaAnalítica() ‘ produção Diária – Analítico
DoCmd.SetWarnings False
Dim dbs As Database, qdf As QueryDef, rst, rsDt As Recordset
Dim i As Integer
Dim dtRel, TitRel, TitRel0, TitRel1, Pasta, Relatório As String
Set dbs = CurrentDb
DoCmd.RunSQL (“UPDATE Agente set x2 = false”)
DoCmd.RunSQL (“UPDATE tblDadosDiáriosEmp_01 INNER JOIN Agente ON tblDadosDiáriosEmp_01.[Chave J] = Agente.CHAVE SET Agente.x2 = Yes”) ‘********
DoCmd.RunSQL (“UPDATE Agente set x1 = false”)
Set rst = dbs.OpenRecordset(“qryAgenteImpressão01”)
Set rsDt = dbs.OpenRecordset(“Auxilio”) ‘************** DtDadosDiários
‘****Parâmetros do Relatório ********************************
Pasta = rsDt!PastaPDF
dtRel = Format(Day(rsDt!DtDadosDiários), “00”) & “-” & Format(Month(rsDt!DtDadosDiários), “00”) & “-” & Format(Year(rsDt!DtDadosDiários), “0000”)
Relatório = “971-DadosDiáriosEmpréstimos-Analítico”
TitRel0 = “ECF-Produção Diária – “
TitRel1 = Pasta & TitRel0 & dtRel
‘************************************************************
With rst
.MoveFirst
Do While Not .EOF
.Edit
.X1 = True
.Update
TitRel = TitRel1 & ” – ” & rst!NOME & ” – ” & rst!CHAVE
DoCmd.OutputTo acOutputReport, Relatório, acFormatPDF, TitRel & “.pdf”
DoCmd.Close acReport, Relatório
.Edit
.X1 = False
.Update
.MoveNext
Loop
End With
DoCmd.RunSQL (“UPDATE Agente set x1 = true”)
End Function

Formulário Inicial – Ocultar menu e objetos

Private Sub Form_Load()
DoCmd.SelectObject acForm, “frmUsuário”, True
DoCmd.RunCoMarca todos os registros

mmand acCmdWindowHide ‘ F11
Call ap_DisableShift
DoCmd.ShowToolbar “ribbon”, acToolbarNo

Funções VBA

Operações com Datas
Format() – DiaMêsAno – Partes da Data
format([data];”dd”) –> retorna o dia “dd”
format([data];”mm”) –> retorna o mês “mm”
format([data];”yyyy”) –> retorna o ano “aaaa”
format([data];”mmdd”) –> retorna o mês e dia “mmdd”
format([data];”yyyymmdd”) –> retorna o ano, mês,dia “yyyymmdd”
format([data];”yyyy-mm-dd”) –> retorna o ano, mês,dia “yyyy-mm-dd”

Retorna um intervalo de tempo entre duas datas.
dateDiff(“yyyy”,[Dat1], [Dat2])
– (Retorna nr de anos entre as duas datas)
dateDiff(“d”,[Dat1], [Dat2])
– (Retorna nr de dias entre as duas datas)

DateAdd(“m”, 1, xDat) (Adiciona 1 mês a xDat)
DateAdd(“d”, 1, xDat) (Adiciona 1 dia a xDat)
DateAdd(“yyyy”, 1, xDat) (Adiciona 1 ano a xDat)

VBA-ACCESS

DoCmd

Abrir Relatório
DoCmd.OpenReport “NomeRel”, acViewPreview
Abrir Relatório com filtro
DoCmd.OpenReport “NomeRel”, acViewPreview, , “CampoRel= ” & Me!CampoForm

Gerar Relatório em PDF
DoCmd.OutputTo acOutputReport, “Rel”, acFormatPDF, “c:\_Dsv\Rel.pdf”

Abrir Formulário
DoCmd.OpenForm “Nome Formuário”
Abrir Consulta
DoCmd.OpenQuery “NomeConsulta”, acNormal, acEdit

Atualizar
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Comandos
Renomear	Name NomeOrigem As NomeDestino
Copiar	FileCopy CaminhoOrigem, CaminhoDestino
Deletar	If Dir(NomeDestino) <> “” Then Kill NomeDestino End If

Eco ComandosDoCmd.SetWarnings False

Ribbon (Sim – Mostra comando no cabeçalho)
DoCmd.ShowToolbar “ribbon”, acToolbarYes
DoCmd.SelectObject acTable, , True

Ribbon (Não mostra comando no cabeçalho)
DoCmd.ShowToolbar “ribbon”, acToolbarNo
DoCmd.SelectObject acTable, , True
DoCmd.RunCommand acCmdWindowHide

Cores

Vermelho	2037680
Azul Escuro	9125192
Azul claro	16711680
Verde	5540692
Verde claro	3329330
Preto	0
Amarelo	65535
Branco	16777215

Private Sub Detalhe_Paint()
If Me.Rnk = 1 Then
Me.Rnk.ForeColor = 2037680 ‘ Vermelho
Me.Rnk.FontBold = True
Else
Me.Rnk.ForeColor = 0
Me.Rnk.FontBold = False
End If
End Sub

Aplicativos externos – (Abrir calculadora)

Private Sub Comando_Click()
Dim Calculadora As Variant
Calculadora = Shell(“C:\Windows\System32\Calc.exe”, 1)
End Sub
———————————————————-

Formulário Inicial – Ocultar menu e objetos

Private Sub Form_Load()
DoCmd.SelectObject acForm, “frmUsuário”, True
DoCmd.RunCoMarca todos os registros

mmand acCmdWindowHide ‘ F11
Call ap_DisableShift
DoCmd.ShowToolbar “ribbon”, acToolbarNo

Funções VBA

Format() – DiaMêsAno – Partes da Data

format(#15/05/2012#,”dd”) :::> retorna o dia 15

format(#15/05/2012#,”mm”) :::> retorna o mês 05

format(#15/05/2012#,”yyyy”) :::> retorna o ano 2012

format(#15/05/2012#,”mmdd”) :::> retorna o mês, seguido do dia 0515

Substituir([DataContratação];”.”;”/”)
– Substitui “.” por “/”, tantas vezes existam na string

Classificar Campo / Filtrar

– Classificar
Me.OrderByOn = True
Me.OrderBy = “CodOrc” ou ”CodOrc & Prefixo”

– Filtrar
txtTip1 = Me.txtTip
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Me.Filter = “Tipo = forms!rubricas!txtTip1”
Me.FilterOn = True

Nome do Banco de dados

Set db = CurrentDb()
Set rs = db.OpenRecordset(“Auxílio”)
rs.Edit
rs!nr = Me.CodContrato
rs.Updatedb.Name

Private Sub RodapéDaPágina_Format(Cancel As Integer, FormatCount As Integer)
Dim db As Database
Set db = CurrentDb()
Me.txtEndS.Caption = db.Name
End Sub
obs: [txtEndS] é um Rótulo

Replace ou Substituir
Substituir([DataContratação];”.”;”/”)
– (Substitui “.” por “/”)
Substituir([Data Contratação];”.”;”“)
– (Remove “.”)

DoCmd.RunSQL

‘(Atribui à variável txt o valor da ChaveJ; Altera o campo txtVar da tabela Auxílio; Abre o formulário frmTesteEdição (filtrado pelo campo txtVar).

Obs: Não deve haver espaços entre ‘Apóstrofo’ e “Aspas”, pois seriam acrescidos à variável “txt”, no início e/ou no final. ‘” & txt & “‘

Private Sub NOME_DblClick(Cancel As Integer)

DoCmd.SetWarnings False

Dim txt As String

txt = Me.ChaveJ

DoCmd.RunSQL (“UPDATE Auxílio set txtVar =‘” & txt & “‘“)

DoCmd.OpenForm “frmTesteEdição”, acNormal

End Sub

Public Function d1AAAAMM(xAAAAMM As String)
‘ Mostra o dia 1º do mês ref à string AAAAMM

Dim x1 As String

Dim y1 As Date

x1 = xAAAAMM

y1 = “01/” & Right(x1, 2) & “/” & Left(x1, 4)

d1AAAAMM = y1

End Function

———————————————

DoCmd.RunSQL

DoCmd.RunSQL (“DELETE * FROM Clientes”)
DoCmd.RunSQL (“UPDATE Age set x = false where age.tipo=’ “paa” ‘ “)
(paa é string)

xReg = Me.NomeRegional
DoCmd.RunSQL (“UPDATE qryAgente00 set x = True where qryAgente00.NomeRegional=’ ” & xReg & ” ‘ “)
(xReg é string) (sem espações entre Apóstrofos e Aspas)

DoCmd.RunSQL (“UPDATE qryAluguéis set qryAluguéis.X = true where qryAluguéis.Beneficiário = ‘” & Me.txtBeneficiário & “‘”) ‘ txtBeneficiário = campo form
DoCmd.RunSQL (“INSERT Into tabDestino ( Camp1, Camp2 ) SELECT Camp1, Camp2 From ObjOrig”)

——————————————————-

yRG = Me.Rg

DoCmd.RunSQL (“UPDATE qryUF set x = true where qryUF.RG=’” & yRG & “‘ ” )

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Exportar para Excel

If MsgBox(“Confirma gerar Excel para ” & [NomeCliente] & “?”, vbYesNo, “Excel para Mala_Lista.xls”) = vbYes Then

DoCmd.TransferSpreadsheet acExport, 8, “qryCadastro”, _

CurrentProject.Path & “\” & “Mala_Lista” & “.xls”, True, “”

Else

MsgBox “Nao gerado”

End If

End Sub

Exemplo:
DoCmd.TransferSpreadsheet acExport, 8, "qry", "C:\_dsv\teste.xls", True, ""

LoadPicture

O exemplo a seguir utiliza a função LoadPicture para carregar um metarquivo em um controle ActiveX de um formulário Funcionários.

Sub ExibirGráfico()

Const strCaminhoBitmapsCon = “C:\Arquivos de Programas\Microsoft Office\Office\Bitmaps\Estilos\”

‘ Declara variáveis de objeto dos tipos Picture e Control.

Dim objFigura As Object, ctl As Control

‘ Define a variável Control para que se refira a um controle ActiveX no formulário.

Set ctl = Forms!Funcionários!AlgumControlePersonalizado

‘ Atribui o valor de retorno de LoadPicture ao objeto Picture.

Set objFigura = LoadPicture(strCaminhoBitmapsCon & “Globo.wmf”)

‘ Define a propriedade Picture de um controle ActiveX.

Set ctl.Picture = objFigura

End Sub

Macro

DoCmd.RunMacro “NomeMacro”

Rodar Consulta ( DoCmd.OpenQuery)
DoCmd.OpenQuery “qryAnoMês_Lançamento0”, acNormal

Abrir Formuário (DoCmd.OpenForm)
DoCmd.OpenForm stDocName, , , stLinkCriteria

Quebra de Página Condicional –
no Rodapé do Grupo onde acontece a quebra – (Nomear o objeto quebra com o nome “QuebraCondicional”

Private Sub RodapéDoGrupo0_Format(Cancel As Integer, FormatCount As Integer)

If Me.Page Mod 2 > 0 Then

Me.QuebraCondicional.Visible = True

Else

Me.QuebraCondicional.Visible = False

End If

End Sub

Ranking – Sql – (Na consulta , modo SQL)

SELECT DISTINCTROW t.Prefixo, t.TipoInfor, t.CodOrc, t.Ano, t.Mes, t.Tip, t.Obs, t.Prod, t.Dot, (select count(*) from [matriz] where obs>t.obs and chave=t.chave)+1 AS Rnk

FROM Matriz AS t ORDER BY t.Obs DESC;

Relatório Zebrado

Private Sub Detalhe_Print(Cancel As Integer, PrintCount As Integer)

dim grade as boolean

Me.Section(0).BackColor = IIf(GRADE, 14935011, 16777215)

GRADE = Not GRADE

End Sub

Caption de Relatório

Private Sub Report_Load()

DoCmd.OpenReport “NomeRelatório”, acViewPreview, “”, “”

Reports![ NomeRelatório].Caption = “Rótulo do Relatório – ” & Me.MsRef

End Sub

SelectObject

O exemplo a seguir seleciona o formulário Clientes na janela Banco de Dados:

DoCmd.SelectObject acForm, “Clientes”, True

Select Case

SQL

UPDATE

UPDATE é especialmente útil quando você quer alterar vários registros ou quando os registros que você quer alterar estão em várias tabelas.

Você pode alterar vários campos ao mesmo tempo. O exemplo a seguir aumenta os valores de Quantia do Pedido em 10% e os valores de Frete em 3% para transportadores no Reino Unido (UK):

UPDATE Pedidos

SET QuantiaDoPedido = QuantiaDoPedido * 1.1,

Frete = Frete * 1.03

WHERE PaísDeDestino = ‘UK’;

Para testar os exemplos a seguir no Microsoft Access, crie primeiro uma nova consulta no banco de dados de exemplo Northwind. Feche a caixa de diálogo Mostrar Tabela sem especificar uma tabela ou consulta. Alterne para modo SQL, cole um exemplo individual na janela SQL e execute a consulta.

Aviso Esses exemplos fazem alterações no banco de dados de exemplo Northwind. Antes de começar, talvez você deseje fazer uma cópia de backup do banco de dados de exemplo.

O exemplo a seguir altera os valores do Supervisor para 5 em todos os registros de funcionários que têm atualmente o valor 2 em Supervisor:

UPDATE Funcionários SET Supervisor = 5 WHERE Supervisor = 2;

O próximo exemplo aumenta em 10 por cento o PreçoUnitário de todos os produtos não-descontinuados do fornecedor 8:

UPDATE Produtos SET PreçoUnitário = PreçoUnitário * 1.1

WHERE CódigoDoFornecedor = 8 AND Descontinuado = No;

O exemplo a seguir reduz em 5 por cento o PreçoUnitário de todos os produtos não-descontinuados fornecidos pela Tokyo Traders. As tabelas Produtos e Fornecedores têm um relacionamento muitos-para-um.

UPDATE Fornecedores INNER JOIN Produtos

ON Fornecedores.CódigoDoFornecedor = Produtos.CódigoDoFornecedor SET PreçoUnitário = PreçoUnitário * .95

WHERE NomeDaEmpresa = ‘Tokyo Traders’ AND Descontinuado = No;

INSERT

INSERT INTO Clientes SELECT * FROM NovosClientes;

O próximo exemplo cria um novo registro na tabela Funcionários:

INSERT INTO Funcionários (Nome,Sobrenome, Cargo) VALUES (‘Paulo’, ‘Braga’, ‘Estagiário’);

O próximo exemplo seleciona todos os estagiários de uma suposta tabela Estagiários que tenham sido contratados há mais de 30 dias e adiciona seus registros à tabela Funcionários.

INSERT INTO Funcionários SELECT Estagiários.* FROM Estagiários WHERE DataDaContratação < Now() – 30;

Você pode utilizar a cláusula INSERT INTO para fazer backup de informações em seu banco de dados antes de ele ser alterado. Você pode, por exemplo, fazer backup de informações em uma tabela Funcionários imediatamente antes de um usuário fazer qualquer alteração aos dados dessa tabela.

DELETE

delete Remaneja.* from Remaneja

sql – db.execute (“update

Public Function TesteDelete()

Dim db As Database

Set db = CurrentDb()

Dim StrSQL$

Dim k#

StrSQL = “DELETE * FROM OrcObservado where MESANO=“ & Forms!frmCaptura!MES & Forms!frmCaptura!ANO & “AND SERET=1”

db.Execute (StrSQL)
‘db.Execute (“DELETE * FROM OrcObser

Dim db As Database

Set db = CurrentDb()

db.Execute (“UPDATE Produtos SET Produtos.X = Yes WHERE produtos.obs = ‘1’ “)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

DoCmd.RunSQL (“DELETE * FROM Clientes”)

DoCmd.RunSQL (“UPDATE Age set check = false”)

DoCmd.RunSQL (“UPDATE tabCbo551 INNER JOIN Agente ON tabCbo551.Usuário = Agente.CHAVE SET Agente.x2 = Yes”)

Private Sub NR_REDE_DblClick(Cancel As Integer)

Dim txtRede As String

txtRede = NR_REDE

Dim db As Database

Set db = CurrentDb()

db.Execute (“update age set age.x = false”)

db.Execute (“update age set age.x = true where age.nr_rede = ‘“ & txtRede & “‘“)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

End Sub

Imprimir Relatórios Marcados

Private Sub cmdImprimeLote_Click()   ‘ Imprime Relatórios Marcados
DoCmd.SetWarnings False
DoCmd.RunSQL (“UPDATE [Sis-Relatorios-Balancete] set Dt = ” “)
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Dim xComando As String
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset(“qry-Sis-Relatorios-Balancete”) ‘ *
Do While Not rs.EOF
    xComando = rs!Rel
    DoCmd.OpenReport xComando, acPreview
    DoCmd.PrintOut acPrintAll, , , acHigh, 1, True
    DoCmd.Close acReport, xComando
    rs.Edit
    rs!dt = “*”
    rs!dt = Now()
    rs.Update
    rs.MoveNext
Loop
MsgBox “Concluído”, vbOKOnly, “Concluído”
End Sub
=======================

Observação: Consulta [Sis-Relatorios-Balancete] - Filtra relatórios escolhidos
SELECT [Sis-Relatorios-Balancete].RelX, [Sis-Relatorios-Balancete].Endereço, [Sis-Relatorios-Balancete].Ordem, [Sis-Relatorios-Balancete].Dt
FROM [Sis-Relatorios-Balancete]
WHERE ((([Sis-Relatorios-Balancete].RelX)=Yes));

———————————————————————————-

InStr ou EmSeq
Localiza uma sequencia de caracteres em um campo.
Retorna um número referente à posição da sequencia no campo. Zero para negativo. No exemplo abaixo, o nº 1 indica que a sequencia será procurada a partir do primeiro caractere do campo.

EmSeq(1;[CampoPesquisado];”Sequencia pesquisada”)

Teclas Especiais

Option Compare DatabaseOption Explicit

‘No exemplo a seguir, a propriedade KeyPreview está definida

‘como True (–1) no procedimento de evento Load do formulário.

‘Isto faz com que o formulário receba eventos de teclado antes

‘que estes sejam recebidos por qualquer outro controle.

‘Em seguida, o evento KeyDown de formulário verifica o valor

‘do argumento KeyCode para determinar se as teclas F2, F3 ou F4

‘foram pressionadas.

Private Sub Form_Load()

Me.KeyPreview = True

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyF2

‘ Processa eventos da tecla F2.

MsgBox “Voce pressionou a tecla F2”

Case vbKeyF3

‘ Processa eventos da tecla F3.

MsgBox “Voce pressionou a tecla F3”

Case vbKeyF4

‘ Processa eventos da tecla F4.

MsgBox “Voce pressionou a tecla F4”

Case vbKeyDown

MsgBox “Voce pressionou Seta para baixo”

Case vbKeyPageDown

MsgBox “Voce pressionou Page Down”

Case Else

MsgBox “Voce nao pressionou as teclas solicitadas.”

End Select

End Sub

‘Você pode utilizar as constantes a seguir para representar

‘valores de teclado. Essas constantes podem ser utilizadas

‘no Microsoft Access em procedimentos de evento para os eventos

‘KeyDown e KeyUp.

‘vbKey0 vbKeyF5 vbKeyNumPad4

‘vbKey1 vbKeyF6 vbKeyNumPad5

‘vbKey2 vbKeyF7 vbKeyNumPad6

‘vbKey3 vbKeyF8 vbKeyNumPad7

‘vbKey4 vbKeyF9 vbKeyNumPad8

‘vbKey5 vbKeyF10 vbKeyNumPad9

‘vbKey6 vbKeyF11 vbKeyO

‘vbKey7 vbKeyF12 vbKeyP

‘vbKey8 vbKeyF13 vbKeyPageDown

‘vbKey9 vbKeyF14 vbKeyPageUp

‘vbKeyA vbKeyF15 vbKeyPause

‘vbKeyAdd vbKeyF16 vbKeyPrint

‘vbKeyB vbKeyG vbKeyQ

‘vbKeyBack vbKeyH vbKeyR

‘vbKeyC vbKeyHelp vbKeyRButton

‘vbKeyCancel vbKeyHome vbKeyReturn

‘vbKeyCapital vbKeyI vbKeyRight

‘vbKeyClear vbKeyInsert vbKeyS

‘vbKeyControl vbKeyJ vbKeySelect

‘vbKeyD vbKeyK vbKeySeparator

‘vbKeyDecimal vbKeyL vbKeyShift

‘vbKeyDelete vbKeyLButton vbKeySnapshot

‘vbKeyDivide vbKeyLeft vbKeySpace

‘vbKeyDown vbKeyM vbKeySubtract

‘vbKeyE vbKeyMButton vbKeyT

‘vbKeyEnd vbKeyMenu vbKeyTab

‘vbKeyEscape vbKeyMultiply vbKeyU

‘vbKeyExecute vbKeyN vbKeyUp

‘vbKeyF vbKeyNumLock vbKeyV

‘vbKeyF1 vbKeyNumPad0 vbKeyW

‘vbKeyF2 vbKeyNumPad1 vbKeyX

‘vbKeyF3 vbKeyNumPad2 vbKeyY

‘vbKeyF4 vbKeyNumPad3 vbKeyZ

Comandos Importantes

DoCmd.OpenForm stDocName, , , stLinkCriteria

DoCmd.OpenReport stDocName, acPreview

DoCmd.Close

DoCmd.GoToRecord , , acFirst

DoCmd.GoToRecord , , acPrevious

DoCmd.GoToRecord , , acNext

DoCmd.GoToRecord , , acLast

DoCmd.GoToRecord , , acNewRec

DoCmd.RunMacro stDocName

DoCmd.OpenQuery stDocName, acNormal, acEdit

‘————————————————

(Marca todos os registros com SIM se o primeiro registro for NÃo e vice-versa)

If Me.X = True Then
DoCmd.RunSQL (“UPDATE Grupos set x = false”)
Else
DoCmd.RunSQL (“UPDATE Grupos set x = true”)
End If

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

‘——————————————————-

Access 2007
DoCmd.SetWarnings False
DoCmd.ShowToolbar “ribbon”, acToolbarNo

———————————————————–

SQL – Insert

Private Sub Comando20_Click()

On Error GoTo Err_Comando20_Click

Dim SQL, sql01, sql02, sql03, sql04, sql05, sql06, sql07, sql08, sql09, sql10 As String

DoCmd.RunSQL (“DELETE * FROM Agente”)

DoCmd.RunSQL (“DELETE * FROM tabCbo551”)

‘*******************************************

sql01 = “INSERT INTO Agente ( CHAVE, CodRegional, CodFunção, CodSupervisor,”

sql02 = “CodGerente, NOME, Piso, TaxaRemuneração, Redutor, TabelaComissão, TabelaComissãoCta,”

sql03 = “CPF, AGÊNCIA, PREFIXO, CONTA, VENCIMENTO, [E-MAIL], TELEFONE, CELULAR, x )”

sql04 = “SELECT Agente1.CHAVE, Agente1.CodRegional, Agente1.CodFunção,”

sql05 = “Agente1.CodSupervisor, Agente1.CodGerente, Agente1.NOME, Agente1.Piso,”

sql06 = “Agente1.TaxaRemuneração, Agente1.Redutor, Agente1.TabelaComissão,”

sql07 = “Agente1.TabelaComissãoCta, Agente1.CPF, Agente1.AGÊNCIA, Agente1.PREFIXO,”

sql08 = “Agente1.CONTA, Agente1.VENCIMENTO, Agente1.[E-MAIL], Agente1.TELEFONE,”

sql09 = “Agente1.CELULAR, Agente1.x “

sql10 = “FROM Agente1”

SQL = sql01 & sql02 & sql03 & sql04 & sql05 & sql06 & sql07 & sql08 & sql09 & sql10

‘MsgBox SQL

CurrentDb.Execute SQL

GERAR PDF INDIVIDUAL
txtAp = Ap
txtCondômino = Condômino
DoCmd.OpenReport “Ap_Pagamentos_02”, acPreview
Reports![Ap_Pagamentos_02].Caption = “Ed PREVI-Extrato – Ap: “ & txtAp & “ – “ & txtCondômino

GERAR PDF INDIVIDUAL

Function PDF_ComEmpAgente()

MsgBox “Marque o PDF Creator como impressora padrão (Painel de Controle”

Dim dbs As Database, qdf As QueryDef, rst, rsDt, rsrub As Recordset

Dim i As Integer

Set dbs = CurrentDb

DoCmd.RunSQL (“UPDATE Agente set x = false”)

Set rst = dbs.OpenRecordset(“qryAgenteImpressão01”)

Set rsDt = dbs.OpenRecordset(“qryCbo551Mes”)

With rst

.MoveFirst

Do While Not .EOF

.Edit

.X = True

.Update

DoCmd.OpenReport “qryComissão-Agente”, acViewPreview, ““, “([Nome]=’“ & rst!NOME & “‘)”

Reports![qryComissão-Agente].Caption = rsDt!ms2 & “ – “ & rst!NOME & “ – “ & rst!CHAVE

DoCmd.PrintOut acPages, 2, 10, acHigh, 1, True

DoCmd.Close acReport, “qryComissão-Agente”

.Edit

.X = False

.Update

.MoveNext

Loop

End With

End Function

Funções

Public Function NrRegTab(xTab As String) ‘ Qte de Registros em Tabela
Dim db As Database
Dim rs As Recordset
Dim nr As Integer
Set db = CurrentDb()
Set rs = db.OpenRecordset(xTab)
NrRegTab = rs.RecordCount
End Function

Public Function AAAAMM(xDt) ‘ Ano – Mês de uma data

If xDt & “*” <> “*” Then
AAAAMM = Year(xDt) & “-” & Format(Month(xDt), “00”)
Else
AAAAMM = “0000-00”
End If
End Function

Public Function AAAMMDD(xDt) ‘ Ano – Mês – Dia de uma data
If xDt & “*” <> “*” Then
aaaammdd = Year(xDt) & Format(Month(xDt), “00”) & Format(Day(xDt), “00”)
Else
aaaammdd = “0000000”
End If
End Function

Public Function MMDD(xDt) ‘ Mês Dia de uma data
If xDt & “*” <> “*” Then
MMDD = Format(Month(xDt), “00”) & Format(Day(xDt), “00”)
Else
MMDD = “0000”
End If
End Function

Mostra o dia 1º do mês ref à string AAAAMM, em formato de data
Public Function d1AAAAMM(xAAAAMM As String) ‘
Dim x1 As String
Dim y1 As Date
x1 = xAAAAMM
y1 = “01/” & Right(x1, 2) & “/” & Left(x1, 4)
d1AAAAMM = y1
End Function

———————————–
Incrementa em um mês a string AAAAMM
Public Function Mais1AAAAMM(xDat As String)
Dim y01, y02, yDat As Date
y01 = d1AAAAMM(xDat) ‘ fornece o dia 1º do mês ref. à string
y02 = y01 + 33
y02 = (y02 – Day(y02)) + 1
Mais1AAAAMM = Year(y02) & Format(Month(y02), “00”)
End Function
—————————————–

Diminui em um mês a string AAAAMM
Public Function Menos1AAAAMM(xDat As String)
Dim y01, y02 As Date
y01 = d1AAAAMM(xDat)
y02 = y01 – 1
y02 = (y02 – Day(y02)) + 1
Menos1AAAAMM = Year(y02) & Format(Month(y02), “00”)
End Function

FERIADOSMÓVEIS
DT	DESCRIÇÃO
17/02/2015	Ter Carnaval
16/02/2015	Seg Carnaval
03/04/2015	Paixão de Cristo
04/06/2015	Corpus Cristi
19/06/2014	Corpus Cristi
18/04/2014	Paixão de Cristo
03/03/2014	Seg Carnaval
04/03/2014	Ter Carnaval

FERIADOSFIXOS
XMES	XDIA	DESCRIÇÃO
1	1	Confraternização Universal
3	25	Libertação Escravos Ceará
4	21	Tiradentes
5	1	Dia do Trabalho
8	15	Nossa Senhora Assunção
9	7	Independência
10	12	Nossa Senhora Aparecida
11	2	Finados
11	15	Proclamação da República
12	24	Natal

Public Function Feriado(xDt) ‘ Feriados
Dim xQt1, xMs, xDi, yMes, xAno As Integer
Dim AnoMes As Long
Dim xDat As String
Dim db As Database
Dim rsF, rsM As Recordset ‘ Feriados Fixos / Móveis
Set db = CurrentDb()
Set rsF = db.OpenRecordset(“FeriadosFixos”)
Set rsM = db.OpenRecordset(“FeriadosMóveis”)

Feriado = ““
‘**********************************************************
Do While Not rsF.EOF() ‘ Feriados Fixos
If MMDD(xDt) = Format(rsF!xMes, “00”) & Format(rsF!xDia, “00”) Then
Feriado = rsF!Descrição
Exit Do
End If
rsF.MoveNext
Loop
‘***********************************************************************
If Feriado = ““ Then
Do While Not rsM.EOF() ‘ Feriados Móveis
If xDt = rsM!dt Then
Feriado = rsM!Descrição
Exit Do
End If
rsM.MoveNext
Loop
End If
‘***********************************************************************
End Function
—————————————————————–

Public Function Testa()
Dim cTeste As String

cTeste = ddmmaaaa(Date)
cTeste = aaaammdd(Date)
cTeste = dSemana(Date)
cTeste = cMes(Date, 0)
cTeste = cMes(Date, 1)
cTeste = retiraStr(“1.234.840,50”, “.”)
cTeste = Zeros(“85”, 4)
cTeste = Zeros(13, 8)
cTeste = iEquiv(30, 360, 10)

End Function

Public Function ddmmaaaa(yDat) ‘Retorna a data em formato ddmmaaaa
ddmmaaaa = Right(“0” + LTrim(Str(Day(yDat))), 2) + Right(“0” + LTrim(Str(Month(yDat))), 2) + Right(Str(Year(yDat)), 4)
End Function

—————————————————————————–

Public Function aaaammdd(yDat) ‘Retorna a data em formato aaaammdd
aaaammdd = Right(Str(Year(yDat)), 4) + Right(“0” + LTrim(Str(Month(yDat))), 2) + Right(“0” + LTrim(Str(Day(yDat))), 2)
End Function

—————————————————————————–
Public Function dSemana(yDat) ‘ Retorna dia da semana abreviado
dSemana = IIf(WeekDay(yDat) = 1, “Dom”, IIf(WeekDay(yDat) = 2, “Seg”, IIf(WeekDay(yDat) = 3, “Ter”, IIf(WeekDay(yDat) = 4, “Qua”, IIf(WeekDay(yDat) = 5, “Qui”, IIf(WeekDay(yDat) = 6, “Sex”, “Sab”))))))
End Function

Public Function cMes(yDat, nTipo) ‘ Retorna nome do mês inteiro ou abreviado
‘ nTipo: 0 = abreviado, 1 = completo
ReDim aMes(12)
aMes(1) = (“janeiro”)
aMes(2) = (“fevereiro”)
aMes(3) = (“março”)
aMes(4) = (“abril”)
aMes(5) = (“maio”)
aMes(6) = (“junho”)
aMes(7) = (“julho”)
aMes(8) = (“Agosto”)
aMes(9) = (“setembro”)
aMes(10) = (“outubro”)
aMes(11) = (“novembro”)
aMes(12) = (“dezembro”)
cMes = IIf(nTipo = 0, Left(aMes(Month(yDat)), 3), aMes(Month(yDat)))
‘nMes = IIf(Month(yDat) = 1, “Jan”, IIf(Month(yDat) = 2, “Fev”, IIf(Month(yDat) = 3, “Mar”, IIf(Month(yDat) = 4, “Abr”, IIf(Month(yDat) = 5, “Mai”, IIf(Month(yDat) = 6, “Jun”, IIf(Month(yDat) = 7, “Jul”, IIf(Month(yDat) = 8, “Ago”, IIf(Month(yDat) = 9, “Set”, IIf(Month(yDat) = 10, “Out”, IIf(Month(yDat) = 11, “Nov”, “Dez”)))))))))))
End Function
—————————————————————————–
Public Function iEquiv(yn1, yn2, yi) ‘ Taxa Equivalente
‘ Período Conhecido, Período Desconhecido, Taxa
iEquiv = (((yi / 100) + 1) ^ (yn2 / yn1) – 1) * 100
End Function
—————————————————————————–
Public Function retiraStr(ByVal varStr As Variant, ByVal strChar As Variant) As String

‘Retira da string a substring indicada, quantas vezes ela apararecer.
‘Recebe string e substring a retirar.

Dim wCharPos As Integer
Dim varTemp As Variant

On Error Resume Next

If IsNull(varStr) Then
retiraStr = ““
Exit Function
Else
If IsNull(strChar) Then strChar = ““
End If

varTemp = ““
wCharPos = InStr(varStr, strChar)
Do Until wCharPos = 0
varTemp = varTemp & Left(varStr, wCharPos – 1)
varStr = Right(varStr, Len(varStr) – Len(strChar) – wCharPos + 1)
wCharPos = InStr(varStr, strChar)
Loop
retiraStr = varTemp & varStr

End Function

—————————————————————————–

‘ Acrescenta zeros à esquerda
Public Function Zeros(pal As Variant, nt As Integer) As String
Dim nr,zr,i As Integer
Dim pl As String
nr = Len(pal) ‘ numero de caracteres da string
zr = nt – nr ‘ quantidade de zeros acrescentar
pl = pal ‘ string resultante
For i = 1 To zr ‘ acrescentar zeros na frente da string
pl = “0” & pl
Next
Zeros = pl
End Function
———————————————————————
Public Function TempoDecorrido(yDat)
Dim xAno As Double
Dim xMes As Double
Dim xDia As Double
xAno = Int((Date – yDat) / 365)
xMes = Int(((((Date – yDat) / 365) – Int((Date – yDat) / 365))) * 12)
xDia = Int(((((((Date – yDat) / 365) – Int((Date – yDat) / 365))) * 12) – Int((((((Date – yDat) / 365) – Int((Date – yDat) / 365))) * 12))) * 30)
TempoDecorrido = IIf(xAno > 0, Trim(Str(xAno)) & “a”, ““) & IIf(xMes > 0, Trim(Str(xMes)) & “m”, ““) & IIf(xDia > 0, Trim(Str(xDia)) & “d”, ““)
End Function
———————————————————————–
Public Function LocalizaSequencia(xContinente, xSequencia As String) As Integer
Dim iSequencia, TamSequencia, TamContinente As Integer
TamContinente = Len(xContinente)
TamSequencia = Len(xSequencia)
‘MsgBox TamContinente & “ – “ & TamSequencia
LocalizaSequencia = False
For iSequencia = 1 To (TamContinente – TamSequencia + 1)
‘ MsgBox “[“ & Mid(xContinente, iSequencia, TamSequencia) & “] – “ & iSequencia, , xSequencia
If Mid(xContinente, iSequencia, TamSequencia) = xSequencia Then
LocalizaSequencia = iSequencia
Exit For
End If
Next iSequencia

End Function
——————————————————————
Public Function Extenso(Valor As Variant) As String ‘ Extenso

ReDim cWord(1 To 6) As String, Cifra(6, 2) As String
Dim WExt As String, WExten As String, CodVar As String
Dim Counter As Integer, aa As Integer, Wsa As Integer

WExt = ““
WExten = ““
Counter = 1
aa = 1

For Wsa = 1 To 6
cWord(Wsa) = ““
Next

If VarType(Valor) = 8 Then
Valor = Val(Valor)
End If

CodVar = Format(Valor, “000000000000000.00”)
CodVar = Left(CodVar, 15) & “0” & Right(CodVar, 2)

Cifra(1, 1) = “TRILHAO”
Cifra(1, 2) = “TRILHOES”
Cifra(2, 1) = “BILHAO”
Cifra(2, 2) = “BILHOES”
Cifra(3, 1) = “MILHAO”
Cifra(3, 2) = “MILHOES”
Cifra(4, 1) = “MIL”
Cifra(4, 2) = “MIL”

Cifra(5, 1) = “REAL”
Cifra(5, 2) = “REAIS”
Cifra(6, 1) = “CENTAVO”
Cifra(6, 2) = “CENTAVOS”

While Counter <= 6
WExt = Extenso_Aux(Mid(CodVar, aa, 3))
If Not VarEmpty(WExt) Then
WExt = WExt + IIf(WExt = “UM “, Cifra(Counter, 1), Cifra(Counter, 2))
cWord(Counter) = WExt
End If
aa = aa + 3
Counter = Counter + 1
Wend

WExten = ““

For aa = 1 To 5
WExten = WExten + IIf(Not VarEmpty(cWord(aa)), cWord(aa), ““)
If aa < 5 Then If Not VarEmpty(cWord(aa + 1)) And Not VarEmpty(WExten) Then WExten = WExten & “, “ End If End If Next If VarEmpty(cWord(5)) And VarEmpty(cWord(4)) And Not VarEmpty(WExten) Then WExten = WExten + (“ DE “ + Cifra(5, 2)) ElseIf VarEmpty(cWord(5)) And Not VarEmpty(cWord(4)) Then WExten = WExten + (“ “ + IIf(Left(cWord(4), 3) = “UM”, Cifra(5, 1), Cifra(5, 2))) End If ‘Verifica Centavos WExten = WExten + IIf(Not VarEmpty(cWord(6)), IIf(Not VarEmpty(WExten), “ E “ + cWord(6), cWord(6)), ““) Extenso = WExten End Function Public Function VarEmpty(C As Variant) As Boolean Dim VTy As Integer Dim MyVar As String VTy = VarType(MyVar) If VTy = vbEmpty Or VTy = vbNull Then VarEmpty = True ElseIf VTy >= vbInteger And VTy <= vbCurrency Then
If C = 0 Then
VarEmpty = True
End If
ElseIf VTy = vbDate Then
If C = “ / / “ Then
VarEmpty = True
End If
ElseIf VTy = vbString Then
MyVar = StrTran(C, Chr(0), Chr(32))
If Len(Trim(MyVar)) = 0 Then
VarEmpty = True
End If
End If

End Function
————————————————————————–
Public Function StrTran(Texto As Variant, Acha As Variant, Troca As Variant) As String

Dim InicioString As Integer
Dim FinalString As Integer
Dim Temp As String

If VarType(Texto) <> vbString Or VarType(Acha) <> vbString Or VarType(Troca) <> vbString Then
If VarType(Texto) = vbNull Then
Temp = ““
Else
Temp = Texto
End If
ElseIf InStr(Texto, Acha) = 0 Then
Temp = Texto
Else
Do
InicioString = InStr(Texto, Acha)
FinalString = InicioString + IIf(Len(Acha) = 0, 1, Len(Acha))
Texto = Mid(Texto, 1, InicioString – 1) & Troca & Mid(Texto, FinalString)
Loop While InStr(Texto, Acha) <> 0
Temp = Texto
End If
StrTran = Temp
End Function

Public Function Extenso_Aux(ByVal Part As String) As String

Dim Posi As Integer, ii As Integer
Dim cWordExtenso As String, C1 As String, C2 As String, C3 As String
ReDim A_Num(1 To 37) As String

A_Num(1) = “001UM “
A_Num(2) = “002DOIS “
A_Num(3) = “003TRES “
A_Num(4) = “004QUATRO “
A_Num(5) = “005CINCO “
A_Num(6) = “006SEIS “
A_Num(7) = “007SETE “
A_Num(8) = “008OITO “
A_Num(9) = “009NOVE “
A_Num(10) = “010DEZ “
A_Num(11) = “011ONZE “
A_Num(12) = “012DOZE “
A_Num(13) = “013TREZE “
A_Num(14) = “014QUATORZE “
A_Num(15) = “015QUINZE “
A_Num(16) = “016DEZESSEIS “
A_Num(17) = “017DEZESSETE “
A_Num(18) = “018DEZOITO “
A_Num(19) = “019DEZENOVE “
A_Num(20) = “020VINTE “
A_Num(21) = “030TRINTA “
A_Num(22) = “040QUARENTA “
A_Num(23) = “050CINQUENTA “
A_Num(24) = “060SESSENTA “
A_Num(25) = “070SETENTA “
A_Num(26) = “080OITENTA “
A_Num(27) = “090NOVENTA “
A_Num(28) = “100CEM “
A_Num(29) = “200DUZENTOS “
A_Num(30) = “300TREZENTOS “
A_Num(31) = “400QUATROCENTOS “
A_Num(32) = “500QUINHENTOS “
A_Num(33) = “600SEISCENTOS “
A_Num(34) = “700SETECENTOS “
A_Num(35) = “800OITOCENTOS “
A_Num(36) = “900NOVECENTOS “
A_Num(37) = “000 “
C1 = Left(Part, 1)
C2 = Mid(Part, 2, 1)
C3 = Right(Part, 1)
Posi = 0
cWordExtenso = ““
For ii = 1 To 37
If Left(A_Num(ii), 3) = Part Then
Posi = ii
Exit For
End If
Next
If Posi <> 0 Then
cWordExtenso = Mid(A_Num(Posi), 4)
Else
Posi = 0
For ii = 1 To 37
If Left(A_Num(ii), 3) = Format(Val(Part) – Val(C3), “000”) Then
Posi = ii
Exit For
End If
Next
If Posi <> 0 Then
cWordExtenso = Mid(A_Num(Posi), 4) + “E “
If cWordExtenso = “CEM E “ And Val(C3) <> 0 Then
cWordExtenso = “CENTO E “
End If
Posi = 0
For ii = 1 To 37
If Left(A_Num(ii), 3) = Format(Val(C3), “000”) Then
Posi = ii
Exit For
End If
Next
cWordExtenso = cWordExtenso + Mid(A_Num(Posi), 4)
Else
Posi = 0
For ii = 1 To 37
If Left(A_Num(ii), 3) = Format(Val(Part) – Val((C2 + C3)), “000”) Then
Posi = ii
Exit For
End If
Next
cWordExtenso = Mid(A_Num(Posi), 4) + “E “
If cWordExtenso = “CEM E “ Then
cWordExtenso = “CENTO E “
End If
Posi = 0
For ii = 1 To 37
If Left(A_Num(ii), 3) = Format(Val((C2 + C3)), “000”) Then
Posi = ii
Exit For
End If
Next
If Posi <> 0 Then
cWordExtenso = cWordExtenso + Mid(A_Num(Posi), 4)
Else
Posi = 0
For ii = 1 To 37
If Left(A_Num(ii), 3) = Format(Val((C2 + C3)) – Val(C3), “000”) Then
Posi = ii
Exit For
End If
Next
cWordExtenso = cWordExtenso + Mid(A_Num(Posi), 4) + “E “
Posi = 0
For ii = 1 To 37
If Left(A_Num(ii), 3) = Format(Val(C3), “000”) Then
Posi = ii
Exit For
End If
Next
cWordExtenso = cWordExtenso + Mid(A_Num(Posi), 4)
End If
End If
End If

Extenso_Aux = cWordExtenso

End Function

Valida CPF

Function FU_ValidaCPF(CPF As String) As Integer
‘
Dim soma As Integer
Dim Resto As Integer
Dim i As Integer

‘Valida
argumento
If Len(CPF) <> 11 Then
FU_ValidaCPF = False
Exit Function
End If

soma
= 0
For i = 1 To 9
soma = soma + Val(Mid$(CPF, i, 1)) * (11 – i)
Next i
Resto = 11 – (soma – (Int(soma / 11) * 11))
If Resto = 10 Or Resto = 11 Then Resto = 0
If Resto <> Val(Mid$(CPF, 10, 1)) Then
FU_ValidaCPF = False
Exit Function
End If

soma
= 0
For i = 1 To 10
soma = soma + Val(Mid$(CPF, i, 1)) * (12 – i)
Next i
Resto = 11 – (soma – (Int(soma / 11) * 11))
If Resto = 10 Or Resto = 11 Then Resto = 0
If Resto <> Val(Mid$(CPF, 11, 1)) Then
FU_ValidaCPF = False
Exit Function
End If

FU_ValidaCPF
= True

End
Function

Function FU_ValidaCGC(CGC As String) As Integer
Dim retorno, a, j, i, d1, d2
If Len(CGC) = 8 And Val(CGC) > 0 Then
a = 0
j = 0
d1 = 0
For i = 1 To 7
a = Val(Mid(CGC, i, 1))
If (i Mod 2) <> 0 Then
a = a * 2
End If
If a > 9 Then
j = j + Int(a / 10) + (a Mod 10)
Else
j = j + a
End If
Next i
d1 = IIf((j Mod 10) <> 0, 10 – (j Mod 10), 0)
If d1 = Val(Mid(CGC, 8, 1)) Then
FU_ValidaCGC = True
Else
FU_ValidaCGC = False
End If
Else
If Len(CGC) = 14 And Val(CGC) > 0 Then
a = 0
i = 0
d1 = 0
d2 = 0
j = 5
For i = 1 To 12 Step 1
a = a + (Val(Mid(CGC, i, 1)) * j)
j = IIf(j > 2, j – 1, 9)
Next i
a = a Mod 11
d1 = IIf(a > 1, 11 – a, 0)
a = 0
i = 0
j = 6
For i = 1 To 13 Step 1
a = a + (Val(Mid(CGC, i, 1)) * j)
j = IIf(j > 2, j – 1, 9)
Next i
a = a Mod 11
d2 = IIf(a > 1, 11 – a, 0)
If (d1 = Val(Mid(CGC, 13, 1)) And d2 = Val(Mid(CGC, 14, 1))) Then
FU_ValidaCGC = True
Else
FU_ValidaCGC = False
End If
Else
FU_ValidaCGC = False
End If
End If
End Function

Substituir([DataContratação];”.”;”/”)
– Substitui “.” por “/”, tantas vezes existam na string

Classificar Campo / Filtrar

– Classificar
Me.OrderByOn = True
Me.OrderBy = “CodOrc” ou ”CodOrc & Prefixo”

– Filtrar
txtTip1 = Me.txtTip
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Me.Filter = “Tipo = forms!rubricas!txtTip1”
Me.FilterOn = True

Nome do Banco de dados

Set db = CurrentDb()
Set rs = db.OpenRecordset(“Auxílio”)
rs.Edit
rs!nr = Me.CodContrato
rs.Updatedb.Name

Private Sub RodapéDaPágina_Format(Cancel As Integer, FormatCount As Integer)
Dim db As Database
Set db = CurrentDb()
Me.txtEndS.Caption = db.Name
End Sub
obs: [txtEndS] é um Rótulo

Replace ou Substituir
Substituir([DataContratação];”.”;”/”)
– (Substitui “.” por “/”)
Substituir([Data Contratação];”.”;”“)
– (Remove “.”)

DoCmd.RunSQL

‘(Atribui à variável txt o valor da ChaveJ; Altera o campo txtVar da tabela Auxílio; Abre o formulário frmTesteEdição (filtrado pelo campo txtVar).

Obs: Não deve haver espaços entre ‘Apóstrofo’ e “Aspas”, pois seriam acrescidos à variável “txt”, no início e/ou no final. ‘” & txt & “‘

Private Sub NOME_DblClick(Cancel As Integer)

DoCmd.SetWarnings False

Dim txt As String

txt = Me.ChaveJ

DoCmd.RunSQL (“UPDATE Auxílio set txtVar =‘” & txt & “‘“)

DoCmd.OpenForm “frmTesteEdição”, acNormal

End Sub

Public Function d1AAAAMM(xAAAAMM As String)
‘ Mostra o dia 1º do mês ref à string AAAAMM

Dim x1 As String

Dim y1 As Date

x1 = xAAAAMM

y1 = “01/” & Right(x1, 2) & “/” & Left(x1, 4)

d1AAAAMM = y1

End Function

———————————————

DoCmd.RunSQL

DoCmd.RunSQL (“DELETE * FROM Clientes”)
DoCmd.RunSQL (“UPDATE Age set x = false where age.tipo=’ “paa” ‘ “)
(paa é string)

xReg = Me.NomeRegional
DoCmd.RunSQL (“UPDATE qryAgente00 set x = True where qryAgente00.NomeRegional=’ ” & xReg & ” ‘ “)
(xReg é string) (sem espações entre Apóstrofos e Aspas)

——————————————————-

yRG = Me.Rg

DoCmd.RunSQL (“UPDATE qryUF set x = true where qryUF.RG=’” & yRG & “‘ ” )

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Exportar para Excel

If MsgBox(“Confirma gerar Excel para ” & [NomeCliente] & “?”, vbYesNo, “Excel para Mala_Lista.xls”) = vbYes Then

DoCmd.TransferSpreadsheet acExport, 8, “qryCadastro”, _

CurrentProject.Path & “\” & “Mala_Lista” & “.xls”, True, “”

Else

MsgBox “Nao gerado”

End If

End Sub

Exemplo:
DoCmd.TransferSpreadsheet acExport, 8, "qry", "C:\_dsv\teste.xls", True, ""

LoadPicture

O exemplo a seguir utiliza a função LoadPicture para carregar um metarquivo em um controle ActiveX de um formulário Funcionários.

Sub ExibirGráfico()

Const strCaminhoBitmapsCon = “C:\Arquivos de Programas\Microsoft Office\Office\Bitmaps\Estilos\”

‘ Declara variáveis de objeto dos tipos Picture e Control.

Dim objFigura As Object, ctl As Control

‘ Define a variável Control para que se refira a um controle ActiveX no formulário.

Set ctl = Forms!Funcionários!AlgumControlePersonalizado

‘ Atribui o valor de retorno de LoadPicture ao objeto Picture.

Set objFigura = LoadPicture(strCaminhoBitmapsCon & “Globo.wmf”)

‘ Define a propriedade Picture de um controle ActiveX.

Set ctl.Picture = objFigura

End Sub

Macro

DoCmd.RunMacro “NomeMacro”

Rodar Consulta ( DoCmd.OpenQuery)
DoCmd.OpenQuery “qryAnoMês_Lançamento0”, acNormal

Abrir Formuário (DoCmd.OpenForm)
DoCmd.OpenForm stDocName, , , stLinkCriteria

Quebra de Página Condicional –
no Rodapé do Grupo onde acontece a quebra – (Nomear o objeto quebra com o nome “QuebraCondicional”

Private Sub RodapéDoGrupo0_Format(Cancel As Integer, FormatCount As Integer)

If Me.Page Mod 2 > 0 Then

Me.QuebraCondicional.Visible = True

Else

Me.QuebraCondicional.Visible = False

End If

End Sub

Ranking – Sql – (Na consulta , modo SQL)

SELECT DISTINCTROW t.Prefixo, t.TipoInfor, t.CodOrc, t.Ano, t.Mes, t.Tip, t.Obs, t.Prod, t.Dot, (select count(*) from [matriz] where obs>t.obs and chave=t.chave)+1 AS Rnk

FROM Matriz AS t ORDER BY t.Obs DESC;

Relatório Zebrado

Private Sub Detalhe_Print(Cancel As Integer, PrintCount As Integer)

dim grade as boolean

Me.Section(0).BackColor = IIf(GRADE, 14935011, 16777215)

GRADE = Not GRADE

End Sub

Caption de Relatório

Private Sub Report_Load()

DoCmd.OpenReport “NomeRelatório”, acViewPreview, “”, “”

Reports![ NomeRelatório].Caption = “Rótulo do Relatório – ” & Me.MsRef

End Sub

SelectObject

O exemplo a seguir seleciona o formulário Clientes na janela Banco de Dados:

DoCmd.SelectObject acForm, “Clientes”, True

Select Case

SQL

UPDATE

UPDATE é especialmente útil quando você quer alterar vários registros ou quando os registros que você quer alterar estão em várias tabelas.

Você pode alterar vários campos ao mesmo tempo. O exemplo a seguir aumenta os valores de Quantia do Pedido em 10% e os valores de Frete em 3% para transportadores no Reino Unido (UK):

UPDATE Pedidos

SET QuantiaDoPedido = QuantiaDoPedido * 1.1,

Frete = Frete * 1.03

WHERE PaísDeDestino = ‘UK’;

Aviso Esses exemplos fazem alterações no banco de dados de exemplo Northwind. Antes de começar, talvez você deseje fazer uma cópia de backup do banco de dados de exemplo.

O exemplo a seguir altera os valores do Supervisor para 5 em todos os registros de funcionários que têm atualmente o valor 2 em Supervisor:

UPDATE Funcionários SET Supervisor = 5 WHERE Supervisor = 2;

O próximo exemplo aumenta em 10 por cento o PreçoUnitário de todos os produtos não-descontinuados do fornecedor 8:

UPDATE Produtos SET PreçoUnitário = PreçoUnitário * 1.1

WHERE CódigoDoFornecedor = 8 AND Descontinuado = No;

UPDATE Fornecedores INNER JOIN Produtos

ON Fornecedores.CódigoDoFornecedor = Produtos.CódigoDoFornecedor SET PreçoUnitário = PreçoUnitário * .95

WHERE NomeDaEmpresa = ‘Tokyo Traders’ AND Descontinuado = No;

INSERT

INSERT INTO Clientes SELECT * FROM NovosClientes;

O próximo exemplo cria um novo registro na tabela Funcionários:

INSERT INTO Funcionários (Nome,Sobrenome, Cargo) VALUES (‘Paulo’, ‘Braga’, ‘Estagiário’);

O próximo exemplo seleciona todos os estagiários de uma suposta tabela Estagiários que tenham sido contratados há mais de 30 dias e adiciona seus registros à tabela Funcionários.

INSERT INTO Funcionários SELECT Estagiários.* FROM Estagiários WHERE DataDaContratação < Now() – 30;

DELETE

delete Remaneja.* from Remaneja

sql – db.execute (“update

Public Function TesteDelete()

Dim db As Database

Set db = CurrentDb()

Dim StrSQL$

Dim k#

StrSQL = “DELETE * FROM OrcObservado where MESANO=“ & Forms!frmCaptura!MES & Forms!frmCaptura!ANO & “AND SERET=1”

db.Execute (StrSQL)
‘db.Execute (“DELETE * FROM OrcObser

Dim db As Database

Set db = CurrentDb()

db.Execute (“UPDATE Produtos SET Produtos.X = Yes WHERE produtos.obs = ‘1’ “)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

DoCmd.RunSQL (“DELETE * FROM Clientes”)

DoCmd.RunSQL (“UPDATE Age set check = false”)

DoCmd.RunSQL (“UPDATE tabCbo551 INNER JOIN Agente ON tabCbo551.Usuário = Agente.CHAVE SET Agente.x2 = Yes”)

Private Sub NR_REDE_DblClick(Cancel As Integer)

Dim txtRede As String

txtRede = NR_REDE

Dim db As Database

Set db = CurrentDb()

db.Execute (“update age set age.x = false”)

db.Execute (“update age set age.x = true where age.nr_rede = ‘“ & txtRede & “‘“)

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

End Sub

Imprimir Relatórios Marcados

Observação: Consulta [Sis-Relatorios-Balancete] - Filtra relatórios escolhidos
SELECT [Sis-Relatorios-Balancete].RelX, [Sis-Relatorios-Balancete].Endereço, [Sis-Relatorios-Balancete].Ordem, [Sis-Relatorios-Balancete].Dt
FROM [Sis-Relatorios-Balancete]
WHERE ((([Sis-Relatorios-Balancete].RelX)=Yes));