ADO PARA DAO

USUARIO.EXCLUIDOS 28/03/2005 15:19:52
#75366
Caros não estou conseguindo passar esta estrutura de ADO para DAO, aguém pode me ajudar


Private Sub Command1_Click()
Dim i As Integer
Dim Max_Wid As Single
Dim Wid As Single
Dim Max_Row As Integer
Dim R As Integer
Dim C As Integer

'Coloca os nomes na coluna fixa
With FG
.TextMatrix(0, 0) = "Código"
.TextMatrix(1, 0) = "Nome"
.TextMatrix(2, 0) = "Endereço"
.TextMatrix(3, 0) = "Cidade"
.TextMatrix(4, 0) = "Estado"
.TextMatrix(5, 0) = "CEP"
.TextMatrix(6, 0) = "Telefone"
End With

'Move para o primeiro registro
Adodc1.Recordset.MoveFirst

'Cria as colunas no grid de acordo com quantos _
'registros tem no banco de dados _
'+ 1 por causa do coluna que é fixa
FG.Cols = Adodc1.Recordset.RecordCount + 1

'carrega os valores do banco de dados no grid
For i = 1 To Adodc1.Recordset.RecordCount
With FG
.Col = i
.Row = 0
.Text = Adodc1.Recordset.Fields("Codigo")
.Row = 1
.Text = Adodc1.Recordset.Fields("Nome")
.Row = 2
.Text = Adodc1.Recordset.Fields("Endereco")
.Row = 3
.Text = Adodc1.Recordset.Fields("Cidade")
.Row = 4
.Text = Adodc1.Recordset.Fields("Estado")
.Row = 5
.Text = Adodc1.Recordset.Fields("CEP")
.Row = 6
.Text = Adodc1.Recordset.Fields("Telefone")
End With
Adodc1.Recordset.MoveNext
Next i

'Ajusta as colunas do grid para o tamanho do texto contido nas celulas
Max_Row = FG.Rows - 1

For C = 0 To FG.Cols - 1
Max_Wid = 0
For R = 0 To Max_Row
Wid = TextWidth(FG.TextMatrix(R, C))
If Max_Wid < Wid Then Max_Wid = Wid
Next R
FG.ColWidth(C) = Max_Wid + 240
Next C
End Sub

Private Sub Form_Load()
'conecta ao banco de dados
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb;Persist Security Info=False"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "Select * from Cadastro"
Adodc1.Refresh
End Sub
USUARIO.EXCLUIDOS 28/03/2005 18:42:55
#75428
Eis este "velho" código DAO, espero que ajude:

Dim bd As Database
Dim rcsFuncionarios As Recordset
Dim rcsCategorias As Recordset
Dim EstadoRecordset As Boolean
Dim hobbies(8) As String



Private Sub cmdAdicionar_Click()
EstadoRecordset = False
rcsFuncionarios.AddNew
LimparCampos

PreenchercboCategorias
CboCategorias.ListIndex = -1
ControlosEditar
End Sub

Private Sub cmdAlterar_Click()
If (Not rcsFuncionarios.BOF) And (Not rcsFuncionarios.EOF) Then
rcsFuncionarios.Edit
EstadoRecordset = True
ControlosEditar
txtCodFuncionario.Enabled = False
txtNome.SetFocus
PreenchercboCategorias
Else
MsgBox "Não existem registos", vbInformation, "Informação"
End If
End Sub

Private Sub cmdAnterior_Click()
'registo anterior
If rcsFuncionarios.RecordCount > 0 Then
rcsFuncionarios.MovePrevious
If rcsFuncionarios.BOF Then
MsgBox "Está no primeiro registo", vbInformation
rcsFuncionarios.MoveFirst
Else
MostrarFuncionario
End If
End If
End Sub

Private Sub cmdApagar_Click()
Dim Resp As Double
If rcsFuncionarios.RecordCount > 0 Then
Resp = MsgBox("Confirma Apagar", vbYesNo + vbQuestion, "Informação")
If Resp = vbYes Then
rcsFuncionarios.Delete
rcsFuncionarios.MoveNext
If rcsFuncionarios.RecordCount > 0 Then
If rcsFuncionarios.EOF Then
rcsFuncionarios.MoveLast
End If
End If
End If
Else
MsgBox "Não existem registos"
Exit Sub
End If

End Sub

Private Sub cmdCancelar_Click()
rcsFuncionarios.CancelUpdate
ControlosNaoEditar
MostrarFuncionario
End Sub

Private Sub cmdImprimir_Click()
rptFuncionarios.Show vbModal
End Sub

Private Sub cmdOk_Click()
On Error GoTo Erro
If EstadoRecordset = False Then rcsFuncionarios("codfuncionario") = txtCodFuncionario.Text
rcsFuncionarios("Nome") = txtNome.Text
rcsFuncionarios("Morada") = txtMorada.Text
rcsFuncionarios("Nomepai") = txtNomePai.Text
rcsFuncionarios("Moradapais") = txtMoradaPais.Text
rcsFuncionarios("Nomemae") = txtNomeMae.Text
rcsFuncionarios("Telefone") = txtTelefone.Text
rcsFuncionarios("Email") = txtEmail.Text
rcsCategorias.MoveFirst
Do While Not rcsCategorias.EOF
If CboCategorias.Text = rcsCategorias("Descricao") Then
rcsFuncionarios("codcategoria") = rcsCategorias("codCategoria")
Exit Do
End If
rcsCategorias.MoveNext
Loop

For n = 0 To 8
If chkHobbies(n).Value = vbChecked Then
rcsFuncionarios(hobbies(n)) = True
Else
rcsFuncionarios(hobbies(n)) = False
End If
Next
If optSexo(1).Value = True Then

rcsFuncionarios("sexo") = True
Else
rcsFuncionarios("sexo") = False
End If

rcsFuncionarios.Update

'tornar registo corrente o último registo alterado
rcsFuncionarios.Bookmark = rcsFuncionarios.LastModified
ControlosNaoEditar

Erro:
If Err <> 0 Then
MsgBox "aqui há gato"
Select Case Err
Case 3022
MsgBox "Funcionário já existente"
txtCodFuncionario.SetFocus
Case Else
cmdCancelar_Click

End Select
End If

' MsgBox Err.Number & Err.Description
End Sub

Private Sub cmdPrimeiro_Click()
'primeiro registo
If rcsFuncionarios.RecordCount > 0 Then
rcsFuncionarios.MoveFirst
MostrarFuncionario
Else
MsgBox "Não existem registos."
End If
End Sub

Private Sub cmdProjectos_Click()
frmFuncionariosProjectos.Show vbModal
End Sub

Private Sub cmdProximo_Click()
'registo seguinte
If rcsFuncionarios.RecordCount > 0 Then
rcsFuncionarios.MoveNext
MostrarFuncionario
If rcsFuncionarios.EOF Then
MsgBox "Está no último registo", vbInformation
rcsFuncionarios.MoveLast
MostrarFuncionario

End If
End If

End Sub

Private Sub cmdUltimo_Click()
'ultimo registo
If rcsFuncionarios.EOF Then
MsgBox "Está no último registo", vbInformation
Else
If rcsFuncionarios.RecordCount > 0 Then
'ultimo registo
rcsFuncionarios.MoveLast
MsgBox "Está no último registo", vbInformation
MostrarFuncionario
End If
End If

rcsFuncionarios.MoveLast
End Sub

Public Sub erro_prim()

Erro:
If rcsFuncionarios.RecordCount > 0 Then
rcsFuncionarios.MoveFirst
Else
MsgBox "Não existem registos."
End If
End Sub

Private Sub cmdVoltar_Click()
Unload Me
End Sub

Private Sub Form_Load()
'Set bdFuncionarios = OpenDatabase(App.Path & "\Funcionarios.mdb")
Set rcsFuncionarios = bdFuncionarios.OpenRecordset("tfuncionarios", dbOpenDynaset)
Set rcsCategorias = bdFuncionarios.OpenRecordset("tCATEGORIAS", dbOpenDynaset)
hobbies(0) = "desporto"
hobbies(1) = "cinema"
hobbies(2) = "ler"
hobbies(3) = "viajar"
hobbies(4) = "praia"
hobbies(5) = "campo"
hobbies(6) = "musica"
hobbies(7) = "estudar"
hobbies(8) = "outros"
cmdPrimeiro_Click
ControlosNaoEditar

End Sub

Public Sub ControlosNaoEditar()

txtCodFuncionario.Enabled = True
txtNome.Locked = True
txtMorada.Locked = True
txtMoradaPais.Locked = True
txtNomePai.Locked = True
txtNomeMae.Locked = True
CboCategorias.Locked = True
txtTelefone.Locked = True
txtEmail.Locked = True
optSexo(0).Enabled = False
optSexo(1).Enabled = False
For i = 0 To 8
chkHobbies(i).Enabled = False
Next
cmdPrimeiro.Enabled = True
cmdAnterior.Enabled = True
cmdUltimo.Enabled = True
cmdProximo.Enabled = True
cmdAlterar.Visible = True
cmdApagar.Visible = True
cmdCancelar.Visible = False
cmdOk.Visible = False
End Sub
Public Sub ControlosEditar()
txtCodFuncionario.Locked = False
txtNome.Locked = False
txtMorada.Locked = False
txtMoradaPais.Locked = False
txtNomePai.Locked = False
txtNomeMae.Locked = False
CboCategorias.Locked = False
txtTelefone.Locked = False
txtEmail.Locked = False
optSexo(0).Enabled = True
optSexo(1).Enabled = True
For i = 0 To 8
chkHobbies(i).Enabled = True
Next
cmdPrimeiro.Enabled = False
cmdAnterior.Enabled = False
cmdUltimo.Enabled = False
cmdProximo.Enabled = False
cmdOk.Left = 360
cmdCancelar.Left = 1560
cmdAlterar.Visible = False
cmdApagar.Visible = False
cmdCancelar.Visible = True
cmdOk.Visible = True

End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub mnuAdicionar_Click()
rcsFuncionarios.AddNew
optSexo(0).Value = False
optSexo(1).Value = False
For i = 0 To 8
chkHobbies(i).Value = vbUnchecked
Next

ControlosEditar
End Sub

Private Sub optSexo_Click(Index As Integer)
optSexo(0).Tag = "V"
optSexo(1).Tag = "F"
End Sub



Public Sub PreencherCategorias()
If rcsCategorias.RecordCount > 0 Then
rcsCategorias.MoveFirst
Do While Not rcsCategorias.EOF
CboCategorias.AddItem rcsCategorias("Descricao")
rcsCategorias.MoveNext
Loop
End If
End Sub

Public Sub LimparCampos()
Dim Obj As Control
For Each Obj In Controls
If TypeOf Obj Is TextBox Then Obj.Text = ""
If TypeOf Obj Is ComboBox Then Obj.Text = ""
If TypeOf Obj Is CheckBox Then Obj.Value = vbUnchecked
'For i = 0 To 8
' chkHobbies(i).Enabled = True
'Next

Next
End Sub

Public Sub MostrarFuncionario()
If Not rcsFuncionarios.EOF Then
LimparCampos
If rcsFuncionarios("CodFuncionario") <> "" Then txtCodFuncionario.Text = rcsFuncionarios("CodFuncionario")
If rcsFuncionarios("Nome") <> "" Then txtNome.Text = rcsFuncionarios("Nome")
If rcsFuncionarios("Morada") <> "" Then txtMorada.Text = rcsFuncionarios("Morada")
If rcsFuncionarios("Nomepai") <> "" Then txtNomePai.Text = rcsFuncionarios("Nomepai")
If rcsFuncionarios("Moradapais") <> "" Then txtMoradaPais.Text = rcsFuncionarios("Moradapais")
If rcsFuncionarios("Nomemae") <> "" Then txtNomeMae.Text = rcsFuncionarios("Nomemae")
Do While Not rcsCategorias.EOF
If rcsCategorias("CodCategoria") = rcsFuncionarios("CodCategoria") Then
CboCategorias.Text = rcsCategorias("Descricao")

End If
rcsCategorias.MoveNext
Loop
txtTelefone.Text = rcsFuncionarios("Telefone")
txtEmail.Text = rcsFuncionarios("Email")
If rcsFuncionarios("sexo") = True Then
optSexo(1).Value = True
Else
optSexo(0).Value = True
End If
For n = 0 To 8
If rcsFuncionarios(hobbies(n)) = True Then
chkHobbies(n).Value = vbChecked
Else
chkHobbies(n).Value = vbUnchecked
End If
Next
On Error GoTo Erro
Set imgFoto.Picture = LoadPicture(App.Path & "\" & rcsFuncionarios("CodFuncionario") & ".bmp")
Erro:
If Err <> 0 Then
If Err = 53 Then
Set imgFoto.Picture = LoadPicture()
Resume Next

End If
End If

End If
End Sub

Public Sub PreenchercboCategorias()
If rcsCategorias.RecordCount > 0 Then
rcsCategorias.MoveFirst
Do While Not rcsCategorias.EOF
CboCategorias.AddItem rcsCategorias("Descricao")
rcsCategorias.MoveNext
Loop
End If

End Sub
USUARIO.EXCLUIDOS 28/03/2005 18:53:53
#75433 Resposta escolhida
Passar de ADO para DAO... é como ter um PENTIUM 4... COM WINDOWS XP..... formatar o bicho e depois Instalar o Windows 3.11... Regredir
Tópico encerrado , respostas não são mais permitidas
Voltar