Dicas e Tutoriais - VB(5.0/6.0)

[camuri 0]

Muito interessante esse código, mas fui testar aqui e parece que falta uma dll, e eu não sei qual.Apresenta esse erro: "User-Defined Tipe not Defined. Olhei nos fóruns da vida mas todas as dicas foram em vão. Será que alguém ai pode me ajudar?

Obrigado.

[camuri 0]

Ha... já testei todos os Microsoft ActiveX Data Objects LIbrary disponíveis

[ValmorLuiz 0]

Colegas, sou novo no forum, mas queria adicionar conhecimento... além de buscar

 

O código abaixo monta o resultado de uma consulta SQL, em um flexgrid, independente da consulta.

 

necessário:

Microsoft ActiveX Data Objects 2.8

Microsoft FlexGrid control 6.0

 

Declarações:

Public CN As New ADODB.Connection
Public RsBusca As New ADODB.Recordset

SQL = Recebe a consulta

 

Public Sub FlexGeral(FlexName As MSFlexGrid, SQL As String)
    RsBusca.Open SQL, CN, adOpenDynamic, adLockOptimistic
    I = 0
    With FlexName
        .Clear
        .Rows = 1
        .Row = 0
        For I = 0 To RsBusca.Fields.Count - 1 'MONTA O CABEÇALHO DAS COLUNAS
            .Cols = I + 1
            .Col = I
            .Text = RsBusca.Fields(I).Name
            .ColWidth(I) = 30 + 120 * Len(RsBusca.Fields(I).Name)
        Next I
        Do While Not RsBusca.EOF 'MONTA OS VALORES NAS LINHAS
            .Rows = .Rows + 1
            For I = 0 To RsBusca.Fields.Count - 1
                .TextMatrix(.Rows - 1, I) = RsBusca.Fields(I).Value & ""
                If .ColWidth(I) < (30 + 120 * Len(RsBusca.Fields(I).Value)) Then 'DEFINE A LARGURA DA COLUNA
                    .ColWidth(I) = 30 + 120 * Len(RsBusca.Fields(I).Value)
                End If
            Next I
            RsBusca.MoveNext
        Loop
        
    End With
    RsBusca.Close
End Sub

[danisz.sp 0]

Oi Pessoal, ns se tem muito a ver com o assunto geral do tópico... mas enfim é em relação a vb 6.0 por isso vou aproveitar pra pedir uma dica/ajuda... eu tenho um programa que foi feito com vb 6.0... ele apresenta figuras na tela e dependendo da tecla que você aperta, aparecem outras figuras e um som wav. O programa roda ok em alguns computadores com vista. Mas está com problemas pra rodar em windows 7... Inicialmente ao clicar no executável do programa aparecia a mensagem: "Component MCI32.OCX or dependencies not correct or registered. A file is missing or invalid." Depois disso, fiz dowload desse arquivo inseri na pasta system32, e tb na pasta do programa... o programa começou a rodar, mas o som não funciona... alguém por acaso teria alguma idéia do que eu poderia tentar fazer pro programa funcionar com o som?! aguardo respostas!!! obrigada!

[ewertonbbv 0]

Bom Dia Luiz,

 

Por gentileza, e para formatar a data? Gostaria que a data estivesse no seguinte formato: ddmmaa, mas ele muda a data se não tiver um separador, como / ou , ou qualquer outro caracter. Como fazer?

 

Desde já agradeço.

 

Abraços

 

Função que verifica se a data está correta, verifando até se o ano é Bissexto.

 

Public Function VerificaData(Maskara As MaskEdBox)

Dim Data      As String
Dim Dia       As String
Dim Mes       As String
Dim Ano       As String
Dim Fevereiro As Integer

Data = Maskara.FormattedText
Dia = Mid(Data, 1, 2)
Mes = Mid(Data, 4, 2)
Ano = Mid(Data, 7, 4)

'Verificando os meses que podem ter até o dia 31
If (Mes = 1) Or (Mes = 3) Or (Mes = 5) Or (Mes = 7) Or (Mes = 8) Or (Mes = 10) Or (Mes = 12) Then
   If (Dia < 1) Or (Dia > 31) Then
      MsgBox ("DIA INVÁLIDO"), vbCritical, "Verifica Data"
      Maskara.SetFocus
      Exit Function
   End If
End If

'Verificando o mes de fevereiro
If (Mes = 2) Then
  If (Dia > 30) Then
      MsgBox ("O MÊS DE FEVEREIO VAI ATE DIA 29"), vbCritical, "Verifica Data"
      Maskara.SetFocus
      Exit Function
  End If
    Fevereiro = Ano Mod 4
 If (Fevereiro <> 0) And (Dia = 29) Then
     MsgBox ("DIA INVÁLIDO O MES É FEVEREIRO O ANO NÃO É BISSEXTO"), vbCritical, "Verifica Data"
     Maskara.SetFocus
     Exit Function
 End If
End If

'Verificar os meses que não podem ter dia até 31 e sim até 30
If (Mes = 2) Or (Mes = 4) Or (Mes = 6) Or (Mes = 9) Or (Mes = 11) Then
  If (Dia < 1) Or (Dia > 30) Then
     MsgBox ("DIA INVÁLIDO O MES É SO ATÉ O DIA 30"), vbCritical, "Verifica Data"
     Maskara.SetFocus
     Exit Function
  End If
End If

'Verificar os meses 1 A 12
If (Mes < 1) Or (Mes > 12) Then
 MsgBox ("MÊS INVÁLIDO"), vbCritical, "Verifica Data"
 Maskara.SetFocus
 Exit Function
End If

MsgBox ("DATA CORRETA"), vbExclamation, "Verifica Data"

End Function

 

Para chamar a função faça da seguinte forma:

Call VerificaData(Data)

[Beavis440 0]

Conexão do objeto ADODC com App.Path.

 

Separa que possa ser intalado o programa em qualquer lugar ou máquina sem precisar de uma programação específica do caminho do banco de Dados.

 

Códidos no Módulo:

 

Public ADODCconect As New ADODB.Connection
Public Arquivo As String

Public Sub ConectaADODC()
   Arquivo = App.Path & "\Dados.mdb"
   ADODCconect.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Arquivo & ";Persist Security Info=False"
   ADODCconect.CursorLocation = adUseClient
   ADODCconect.Open
End Sub

 

Códigos no Formulário:

"Dados" é o objeto ADODC do meu formulário.

"DataDrid1" é o DataGrid que coloquei no formulário, os nomes desses 2 objetos devem ser mudados conforme o nome que vocês colocaram no projeto de vcs.

 

Private Sub Form_Load()
   ConectaADODC
   Dados.ConnectionString = ADODCconect
   Set DataGrid1.DataSource = Dados
End Sub

 

Nas propriedades do ADODC faz o seguinte:

ConnectionString:

Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=Dados.mdb;Mode=Share Deny None;Jet OLEDB:System database="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;

 

RecordSource: Coloque o comando SQL que desejar.