Ailton Zacarias (Desenvolvedor VBA)

CriarVinculo

ailtonzacarias — Tue, 23 Sep 2008 15:13:36 +0000

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

ailtonzacarias — Tue, 23 Sep 2008 15:09:12 +0000

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

ailtonzacarias — Tue, 23 Sep 2008 15:06:01 +0000

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

ailtonzacarias — Tue, 23 Sep 2008 15:02:13 +0000

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

ailtonzacarias — Tue, 23 Sep 2008 15:01:43 +0000

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

ailtonzacarias — Tue, 22 Jan 2008 18:41:58 +0000

‘ 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

ailtonzacarias — Sat, 19 Jan 2008 12:29:13 +0000

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

ailtonzacarias — Fri, 18 Jan 2008 23:32:37 +0000

Public Function ImportarPlanilha()

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, “tblClientes”, “C:\Clientes.xls”, True, “Clientes!a1:g35″

End Function

Mês Atual

ailtonzacarias — Fri, 18 Jan 2008 23:21:55 +0000

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

ailtonzacarias — Fri, 18 Jan 2008 23:20:37 +0000

Public Function Idade(DataDeNascimento As Date)

Idade = DateDiff(“yyyy”, Data_Nascimento, Now()) + Int(Format(Now(), “mmdd”) < Format(Data_Nascimento, “mmdd”))

End Function