Jump to content

O formulário grava todos os valores como texto


bruno_131085
 Share

Recommended Posts

Estou a fazer um programa em VBA do excel que usa base de dados. Quando eu preencho o formulário e gravo, os valores são sempre transportados como texto, mesmo que eu defina para no código para formatar como número, data, hora, etc, ele continua a gravar como texto. Se eu formatar as células no excel para número, dá-me o erro de conversão do tipo de dados. Alguma solução?

Cumprimentos

Link to comment
Share on other sites

O código é o seguinte

Option Explicit

Dim Db As Database
Dim RSR, RSC, RSRCONT As Recordset

Sub PreencherCampos()
    Dim NLin
    If RSR.EOF And RSR.BOF Then
    Else
        Me.txtEntrada = RSR("Entrada")
        Me.txtDatadaEntrada = Format(RSR("DataDaEntrada"), "dd-mm-yyyy")
        Me.txtFornecedor = RSR("Fornecedor")
        Me.cbDesignação = RSR("Designação")
        Me.txtVolume = RSR("Volume")
        If RSR("AspectoConforme") = "Sim" Then
            cboxConformidade = False
        ElseIf RSR("AspectoConforme") = "Não" Then
            cboxConformidade = True
        End If
        Me.txtHoraEnsaio = RSR("HoraDoEnsaio")
        Me.txtResultadoSlump = RSR("Slump")
        Me.txtMatrícula = RSR("Matrícula")
        Me.txtGuia = RSR("GuiaDeTransporte")
        Me.txtHoraSaída = RSR("SaídaDaCentral")
        Me.txtHoraChegada = RSR("ChegadaÀObra")
        Me.cbFrenteDeTrabalho = RSR("FrenteDeTrabalho")
        Me.txtElemento = RSR("Elemento")
        Me.txtInícioBetonagem = RSR("InicioDaBetonagem")
        Me.txtFimBetonagem = RSR("FimDaBetonagem")
        Me.txtAmostra = RSR("Amostra")
        Me.txtLote = RSR("Lote")
        Me.txtNProvetes = RSR("NProvetes")
        Me.txtAmbiente = RSR("TemperaturaAmbiente")
        Me.txtBetãoFresco = RSR("TemperaturaBetão")
        Me.txtObservações = RSR("Observações")
    End If
    
    Set RSC = Db.OpenRecordset("SELECT * FROM [CompressãoLNEC226$] WHERE Entrada= " & RSR("Entrada") & " ORDER BY Entrada;")
End Sub

Private Sub cboxConformidade_Change()
    If cboxConformidade = False Then
        Label80.Visible = False
    ElseIf cboxConformidade = True Then
        Label80.Visible = True
    End If
End Sub

Private Sub cmdbAlterar1_Click()
    Dim Resp
    Resp = MsgBox("De certeza que deseja alterar a entrada nº " & Me.txtEntrada, vbQuestion + vbYesNo, "")
    If Resp = vbYes Then
        RSR.Edit
        RSR("Entrada") = txtEntrada
        RSR("DataDaEntrada") = Format(txtDatadaEntrada, "dd-mm-yyyy")
        RSR("Fornecedor") = Me.txtFornecedor
        RSR("Designação") = Me.cbDesignação
        RSR("Volume") = Me.txtVolume
        If cboxConformidade = False Then
            RSR("AspectoConforme") = "Sim"
        ElseIf cboxConformidade = True Then
            RSR("AspectoConforme") = "Não"
        End If
        RSR("HoraDoEnsaio") = Me.txtHoraEnsaio
        RSR("Slump") = Me.txtResultadoSlump
        RSR("Matrícula") = Me.txtMatrícula
        RSR("GuiaDeTransporte") = Me.txtGuia
        RSR("SaídaDaCentral") = Me.txtHoraSaída
        RSR("ChegadaÀObra") = Me.txtHoraChegada
        RSR("FrenteDeTrabalho") = Me.cbFrenteDeTrabalho
        RSR("Elemento") = Me.txtElemento
        RSR("InicioDaBetonagem") = Me.txtInícioBetonagem
        RSR("FimDaBetonagem") = Me.txtFimBetonagem
        RSR("Amostra") = Me.txtAmostra
        RSR("Lote") = Me.txtLote
        RSR("NProvetes") = Me.txtNProvetes
        RSR("TemperaturaAmbiente") = Me.txtAmbiente
        RSR("TemperaturaBetão") = Me.txtBetãoFresco
        RSR("Observações") = Me.txtObservações
        RSR.Update
        UserForm_Initialize
        cmdbÚltimo_Click
    End If
End Sub

Private Sub cmdbExcluir_Click()
    Unload Me
End Sub

Private Sub cmdbNovo_Click()
    Me.Menu.Value = 0
    Me.txtEntrada = RSRCONT("Total") + 1
    Me.txtDatadaEntrada = Format(Date, "dd-mm-yyyy")
    Me.txtFornecedor = Empty
    Me.cbDesignação = Empty
    Me.txtVolume = Empty
    Me.txtHoraEnsaio = Empty
    Me.txtResultadoSlump = Empty
    Me.txtMatrícula = Empty
    Me.txtGuia = Empty
    Me.txtHoraSaída = Empty
    Me.txtHoraChegada = Empty
    Me.cbFrenteDeTrabalho = Empty
    Me.txtElemento = Empty
    Me.txtInícioBetonagem = Empty
    Me.txtFimBetonagem = Empty
    Me.txtAmostra = Empty
    Me.txtLote = Empty
    Me.txtNProvetes = Empty
    Me.txtAmbiente = Empty
    Me.txtBetãoFresco = Empty
    Me.txtObservações = Empty
    Me.lblProduto = Empty
    cboxConformidade = False
    cmdbInício.Enabled = False
    cmdbAnterior.Enabled = False
    cmdbSeguinte.Enabled = False
    cmdbÚltimo.Enabled = False
    cmdbIr.Enabled = False
    txtIr.Enabled = False
    txtIr.BackStyle = fmBackStyleTransparent
    cmdbInserir1.Visible = True
End Sub

Private Sub cmdbInserir1_Click()
    RSR.AddNew
    RSR("Entrada") = Me.txtEntrada
    RSR("DataDaEntrada") = Format(txtDatadaEntrada, "dd-mm-yyyy")
    RSR("Fornecedor") = Me.txtFornecedor
    RSR("Designação") = Me.cbDesignação
    RSR("Volume") = Me.txtVolume
    If cboxConformidade = False Then
        RSR("AspectoConforme") = "Sim"
    ElseIf cboxConformidade = True Then
        RSR("AspectoConforme") = "Não"
    End If
    RSR("HoraDoEnsaio") = Me.txtHoraEnsaio
    RSR("Slump") = Me.txtResultadoSlump
    RSR("Matrícula") = Me.txtMatrícula
    RSR("GuiaDeTransporte") = Me.txtGuia
    RSR("SaídaDaCentral") = Me.txtHoraSaída
    RSR("ChegadaÀObra") = Me.txtHoraChegada
    RSR("FrenteDeTrabalho") = Me.cbFrenteDeTrabalho
    RSR("Elemento") = Me.txtElemento
    RSR("InicioDaBetonagem") = Me.txtInícioBetonagem
    RSR("FimDaBetonagem") = Me.txtFimBetonagem
    RSR("Amostra") = Me.txtAmostra
    RSR("Lote") = Me.txtLote
    RSR("NProvetes") = Me.txtNProvetes
    RSR("TemperaturaAmbiente") = Me.txtAmbiente
    RSR("TemperaturaBetão") = Me.txtBetãoFresco
    RSR("Observações") = Me.txtObservações
    RSR.Update
    cmdbInserir1.Visible = False
    cmdbInício.Enabled = True
    cmdbAnterior.Enabled = True
    cmdbSeguinte.Enabled = True
    cmdbÚltimo.Enabled = True
    cmdbIr.Enabled = True
    txtIr.Enabled = True
    txtIr.BackStyle = fmBackStyleOpaque
    UserForm_Initialize
End Sub

Private Sub cmdbInício_Click()
    RSR.MoveFirst
    Me.PreencherCampos
    Me.txtElemento = 1
    Me.lblNavegação.Caption = "1 de " & RSRCONT("Total")
End Sub

Private Sub cmdbAnterior_Click()
    If Me.txtEntrada > 1 Then
        RSR.MovePrevious
        Me.txtEntrada = Me.txtEntrada - 1
        Me.lblNavegação.Caption = Me.txtEntrada & " de " & RSRCONT("Total")
        Me.PreencherCampos
    End If
End Sub

Private Sub cmdbSeguinte_Click()
    If CInt(Me.txtEntrada) < CInt(RSRCONT("Total")) Then
        RSR.MoveNext
        Me.txtEntrada = Me.txtEntrada + 1
        Me.lblNavegação.Caption = Me.txtEntrada & " de " & RSRCONT("Total")
        Me.PreencherCampos
    End If
End Sub

Private Sub cmdbÚltimo_Click()
    RSR.MoveLast
    Me.PreencherCampos
    Me.txtElemento = RSRCONT("Total")
    Me.lblNavegação.Caption = RSRCONT("Total") & " de " & RSRCONT("Total")
End Sub

Private Sub cmdbIr_Click()
    RSR.FindFirst "Entrada= '" & Me.txtIr & "'"
    If Not RSR.NoMatch Then
        Me.PreencherCampos
    Else
        MsgBox "A entrada não é válida", vbInformation, ""
    End If
    Me.lblNavegação.Caption = txtEntrada & " de " & RSRCONT("Total")
    Me.txtIr = Empty
End Sub

Private Sub Normal_Click()
Normal.Visible = False
RSR.MoveLast
    Me.PreencherCampos
    Me.txtElemento = RSRCONT("Total")
    Me.lblNavegação.Caption = RSRCONT("Total") & " de " & RSRCONT("Total")
Normal.Visible = True
End Sub

Private Sub UserForm_Initialize()
    cbDesignação.RowSource = "Definições!c3:c18"
    cbFrenteDeTrabalho.RowSource = "Definições!f2:f15"
    txtDatadaEntrada = Format(Date, "dd-mm-yyyy")
    Me.Menu.Value = 0
    Set Db = OpenDatabase(ThisWorkbook.Path & "\" & ThisWorkbook.Name, False, False, "Excel 8.0")
    Set RSR = Db.OpenRecordset("SELECT * FROM [Recepção$] ORDER BY Entrada;")
    Me.PreencherCampos
    Set RSRCONT = Db.OpenRecordset("SELECT COUNT([Entrada]) As [Total] FROM [Recepção$];")
    txtEntrada = 1
    If RSRCONT("Total") = 0 Then
        cmdbInserir1.Visible = True
        lblEntrada.Caption = "Entrada N.º"
        Me.lblNavegação.Caption = Me.txtEntrada & " de 1"
    ElseIf RSRCONT("Total") >= 1 Then
        cmdbInserir1.Visible = False
        Me.lblNavegação.Caption = Format(Me.txtEntrada, "") & " de " & RSRCONT("Total")
    End If
End Sub

Private Sub UserForm_Terminate()
    Db.Close
End Sub

Cumprimentos

Link to comment
Share on other sites

Grava como texto na base de dados? Tens os campos na base de dados definidos com outro formato(data, numericos, etc) ?

Boas! Grava sempre como base de dados. Já fiz o código para formatar os valore, tanto na entrada como saída e já formatei directamente as células. Nenhuma das alternativas funcionou e nesta última é quando dá o erro de conversão do tipo de dados. Tive de pôr as células com formatação geral para não dar o erro.

Já agora agradecia que me ajudassem noutro assunto. A folha de base de dados está no mesmo ficheiro do programa. Contudo queria que a base de dados estivesse noutro ficheiro a parte. Conseguem ajudar-me nisso?

Cumprimentos

Link to comment
Share on other sites

Não entendeste ... tens os campos na base de dados definidos como texto ou outro tipo de dados?

Sim eu entendi. Já tive definido de acordo com o tipo de dados que queria (número, hora, texto, etc), mas quando está assim ele dá o erro de conversão de dados. Para não dar o erro tive de pôr as células todas como geral ou como texto, caso contrário não dá.

Também já formatei os dados através do código e continua a não dar 😉

Link to comment
Share on other sites

Bom dia,

Já fiz isso e continua a não dar 😉 O erro que me dá é erro 3464 "Tipo de dados incorrectos na expressão de critérios". O erro aparece depois de eu introduzir os valores na página dois e fizer seguinte. Deixo aqui o ficheiro. Se puderes dar uma vista de olhos agradecia.

http://www.4shared.com/file/G54fEbtm/Boletim_de_Recepo_de_Beto.html

Eu precisava de fazer uns cálculos, que suponho que não estejam a dar porque os valores estão como texto. As expressões que estou a tentar a por são as seguintes:

Private Sub txtCargaRotura_Change()

txtTensãoRotura=txtTensãoRotura/txtComp/txtLargura

End Sub

Private Sub txtIdade_Change()

txtDataEnsaio = txtDataFabrico + txtIdade

End Sub

Private Sub txtPesoProvete_Change()

txtMassaVolúmica = Application.WorksheetFunction.Round(+txtPesoProvete / txtComp / txtLargura / txtAltura, -1)

End Sub 

Esta última não sei se está correcta. Se pudessem dar uma vista de olhos nisto também agradecia.

Cumprimentos

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.