Algumas dicas para desenvolvedores em Visual Basic:

 

Centralizar Form dentro de um MDIForm

ComboBox Inteligente

Conexão de .mdb em ADO

Ler arquivo texto

Mudar de campo com o ENTER

Preencher ComboBox

Retornar tipo do objeto

Tratamento de erro ADO

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Procedure para Centralizar Form dentro do MDI
Sub SU_CentralizaForm(VA_Form As Form)
If VA_Form.MDIChild Then
VA_Form.Top = ((Screen.Height - VA_Form.Height) / 2)
VA_Form.Left = ((Screen.Width - VA_Form.Width) / 2)
Else
VA_Form.Top = ((Screen.Height - VA_Form.Height) / 2) + (mdiPrincipal.pnlUnused.Height - 150)
VA_Form.Left = ((Screen.Width - VA_Form.Width) / 2)
End If
End Sub

 

 

 

 

 

 

 

 

 

 

 

 

Procedure ComboBox Inteligente
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const CB_ERR = (-1)
Public Const CB_FINDSTRING = &H14C
Sub BuscaCbo(cbo As ComboBox, KeyAscii As Integer)
Dim sBuffer As String
Dim lRetVal As Long
sBuffer = Left(cbo.Text, cbo.SelStart) & Chr(KeyAscii)
lRetVal = SendMessage((cbo.hwnd), CB_FINDSTRING, -1, ByVal sBuffer)
If lRetVal <> CB_ERR Then
cbo.ListIndex = lRetVal
cbo.Text = cbo.List(lRetVal)
cbo.SelStart = Len(sBuffer)
cbo.SelLength = Len(cbo.Text)
KeyAscii = 0
End If
End Sub

 

 

 

 

 

 

 

 

 

Conexão ADO para Access
'Colocar esse código no módulo BAS
Public Const DBProvider = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source="
Public ConexaoADO As ADODB.Connection
Public Erro As Error
Public Erro As Error Public ColecaoErros As Variant
Public Contador As Integer
Public strErro As String
Public Sub SU_Conecta()
On Error GoTo Erro_Conexao
Set ConexaoADO = New ADODB.Connection
Set ColecaoErros = ConexaoADO.Errors
ConexaoADO.ConnectionString = DBProvider & App.Path & "\Banco.MDB"
ConexaoADO.Open
Exit Sub
Erro_Conexao:
SU_TrataErros
End Sub

 

 

 

 

 

 

 

 

 

Ler Arquivo Texto
Private Sub SU_LerArquivoTexto()
Dim vlArq As String
vlArq = App.Path & "\Arquivo.txt"
If Dir(vlArq) <> "" Then
Open vlArq For Input As #1
Do While Not EOF(1)
Line Input #1, TEXTLINE
Loop
Close #1
End If
End Sub

 

 

 

 

 

 

 

 

Mudar de campo com o ENTER
Private Sub Form_Load()
Me.KeyPreview = True
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
SendKeys "{Tab}"
KeyAscii = 0
End If
End Sub

 

 

 

 

 

 

 

 

 

 

 

 

Preencher ComboBox
Sub SU_PreencheComboGenerico(ArgColocaCodigo As Boolean, ArgSelect As String, _ ArgCombo As ComboBox)
Dim VL_Combo As Recordset
On Error GoTo ErroPreencheComboGenerico
ArgCombo.Clear
Set VL_Combo = ConexaoADO.Execute(ArgSelect)
If Not VL_Combo.BOF And Not VL_Combo.EOF Then
VL_Combo.MoveFirst
While Not VL_Combo.EOF
If ArgColocaCodigo = True Then
ArgCombo.AddItem VL_Combo(0) & " - " & VL_Combo(1)
Else
ArgCombo.AddItem VL_Combo(1)
End If
ArgCombo.ItemData(ArgCombo.NewIndex) = VL_Combo(0)
VL_Combo.MoveNext
Wend
End If
VL_Combo.Close
Exit Sub
ErroPreencheComboGenerico:
SU_TrataErros
End Sub

 

 

 

 

 

 

 

Retorna Tipo do Objeto
Function FU_RetornaTipo(vlObj As Object)
If vlObj.Type = adBigInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adBinary Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adBSTR Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adChar Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adCurrency Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adDate Then
FU_RetornaTipo = "DATA"
ElseIf vlObj.Type = adDBDate Then
FU_RetornaTipo = "DATA"
ElseIf vlObj.Type = adDBTime Then
FU_RetornaTipo = "DATA"
ElseIf vlObj.Type = adDBTimeStamp Then
FU_RetornaTipo = "DATA"
ElseIf vlObj.Type = adDecimal Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adDouble Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adEmpty Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adInteger Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adLongVarBinary Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adLongVarChar Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adLongVarWChar Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adNumeric Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adSingle Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adSmallInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adTinyInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adUnsignedBigInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adUnsignedInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adUnsignedSmallInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adUnsignedTinyInt Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adVarBinary Then
FU_RetornaTipo = "NUMERO"
ElseIf vlObj.Type = adVarChar Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adVariant Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adVarWChar Then
FU_RetornaTipo = "STRING"
ElseIf vlObj.Type = adWChar Then
FU_RetornaTipo = "STRING"
Else
FU_RetornaTipo = "STRING"
End If
End Function

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Tratamento de Erro ADO
Public Sub SU_TrataErros()
'Verificar e mostrar erros de conexão
For Each Erro In ColecaoErros
With Erro
  strErro = "Erro #" & Contador & vbCrLf
strErro = strErro & " ADO Error #" & .Number & vbCrLf
  strErro = strErro & " Description " & .Description & vbCrLf
strErro = strErro & " Source " & .Source
  Debug.Print Contador + 1
  msgbox strErro, vbokonly, "ERRO"
End With
Next
End Sub