CriarVinculo
Public Function CriarVinculo()
Dim rVinculo As DAO.Recordset
Set rVinculo = CurrentDb.OpenRecordset(“Select * from admVinculos”)
While Not rVinculo.EOF
DoCmd.TransferDatabase acLink, “ODBC”, “ODBC;DSN=” & rVinculo.Fields(“Banco”) & “;UID=” & rVinculo.Fields(“Usuario”) & “;PWD=” & rVinculo.Fields(“Senha”) & “;LANGUAGE=us_english;DATABASE=” & rVinculo.Fields(“Base”) & “”, acTable, rVinculo.Fields(“Origem”), rVinculo.Fields(“Destino”), , True
rVinculo.MoveNext
Wend
rVinculo.Close
Set rVinculo = Nothing
End Function
RemoverVinculo
Public Function RemoverVinculo()
Dim rVinculo As DAO.Recordset
Set rVinculo = CurrentDb.OpenRecordset(“Select * from admVinculos”)
While Not rVinculo.EOF
DoCmd.DeleteObject acTable, rVinculo.Fields(“Destino”)
rVinculo.MoveNext
Wend
rVinculo.Close
Set rVinculo = Nothing
End Function
ExecutarSQL
Public Function ExecutarSQL(strSQL As String)
‘Desabilitar menssagens de execução de comando do access
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
‘Abilitar menssagens de execução de comando do access
DoCmd.SetWarnings True
End Function
FindLastRow
Function FindLastRow(XPlanilha) As Variant
Dim LastRow As Variant
If XPlanilha.WorksheetFunction.CountA(XPlanilha.Cells) > 0 Then
LastRow = XPlanilha.Cells.Find(What:=”*”, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
FindLastRow = LastRow
End Function
ImprimirExcel
Public Function ImprimirExcel(Modelo As String)
Dim XPlanilha As Object
Set XPlanilha = CreateObject(“Excel.Application”)
‘Abre o arquivo modelo
XPlanilha.Workbooks.Open (Modelo)
‘Seleciona a primeira planilha
XPlanilha.Workbooks(1).Sheets(1).Select
XPlanilha.ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
XPlanilha.Application.DisplayAlerts = False
XPlanilha.Quit
XPlanilha.Application.DisplayAlerts = True
Set XPlanilha = Nothing
End Function
Cálculo de comissão
‘ Cálculo de comissão usando a regra de três
Public Function Comissao(valParcela, valAvista, valComissao)
Comissao = (valcomissao * (valParcela / valAvista * 100)) / 100
End Function
bkp.bat
set var1=_
set var2=-
xcopy “C:\_OrigemBKP\*.*” C:\_DestinoBKP /I/E/V/F/D/Y/C > C:\%date:~12,2%%var1%%date:~7,2%%var1%%date:~4,2%%var1
%%time:~0,2%%var2%%time:~3,2%_BKP.log
echo.
echo BACK-UP CONCLUIDO!!!
echo.
pause
exit
Importar Planilha
Public Function ImportarPlanilha()
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, “tblClientes”, “C:\Clientes.xls”, True, “Clientes!a1:g35″
End Function
Mês Atual
Function MesAtual(intMes As Integer) As String
Dim myMonth As Variant
myMonth = Array(“”, “Janeiro”, “Fevereiro”, “Maro”, “Abril”, “Maio”, “Junho”, “Julho”, “Agosto”, “Setembro”, “Outubro”, “Novembro”, “Dezembro”)
MesAtual = myMonth(intMes)
End Function
Idade
Public Function Idade(DataDeNascimento As Date)
Idade = DateDiff(“yyyy”, Data_Nascimento, Now()) + Int(Format(Now(), “mmdd”) < Format(Data_Nascimento, “mmdd”))
End Function
