Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

nereu1301

[Resolvido] mshFlexGrid e tabela access

Por , em Visual Basic

Recommended Posts

nereu1301    0

nereu1301
Postado

entao

volto a pedir ajuda a quem entende

seguinte: abra uma Ordem de Serviço de um cliente através de um form, que entre muitos dados, um deles é jogar as peças utilizadas num conserto num MshflexGrid. Até ai tudo bem, funciona muito bem com esta sub:

 

Private Sub CmdIncluirPec_Click()
    'inclui dados no primeiro grid
    'chr$(9) é pra mudar de celula com enter
    GrdIncluiPec.AddItem TxtCodPeca.Text + Chr$(9) + TxtNomePeca.Text + Chr$(9) + _
    TxtQuant.Text + Chr$(9) + TxtValor.Text + Chr$(9) + TxtTotLinha.Text
    TxtCodPeca.SetFocus
    TxtCodPeca.Text = ""
    TxtNomePeca.Text = ""
    TxtQuant.Text = ""
    TxtValor.Text = ""
    TxtTotLinha.Text = ""
End Sub

acontece que um conserto usa diversas peças e com isso a flex vai ter muitas linhas e ai começa o problema retornando erro sinalizando no execute aqui:

 

Private Sub IncluirDados()
Dim vConfMsg As Integer
Dim vErro As Boolean
Dim vOK As Integer
    'inicializa as variaveis auxiliares
    vConfMsg = vbExclamation + vbOKOnly + vbSystemModal
    vErro = False
    'verifica os dados digitados
    If TxtDataInicioServico.Text = Empty Then
        MsgBox "O campo Data Entrada não foi preenchido.", vConfMsg, "Erro"
        vErro = True
    End If
    If TxtHoraInicioServico.Text = Empty Then
        MsgBox "O campo Hora Entrada não foi preenchido.", vConfMsg, "Erro"
        vErro = True
    End If
    'Se acontece um erro sai da sub sem gravar
    If vErro Then Exit Sub
    With cnnComando
        .ActiveConnection = cnnCetecInfServiços
        .CommandType = adCmdText
        'cria o modulo sql
        .CommandText = "INSERT INTO Oficina1" & _
        "(Data_Inicio_Servico, Hora_Inicio_Servico, Numero_OS, Nome, Produto, Prog, Reg, MaqAcid, GrAlim, ConjTecl, MaqTranc, PlBsEletr, CjEntr, GrDis, GrImpr, CjEsc, Pint, RevGer, Mon, CjLeit, Lubr, CjTab, CabImpr, Desm, AlimEscr, LavTratFer, RevGrMot, Lacr, RetCilCar, RevEletr, Solda, Outros, CodPeca, NomePeca, Quant, Valor, TotLinha, Obs, Data_Term_Serv, Hora_Term_Serv) Values('" & _
        TxtDataInicioServico.Text & "', '" & TxtHoraInicioServico.Text & "', " & _
        TxtNumOS.Text & ", '" & TxtNomeCliente.Text & "', '" & TxtProduto.Text & "', " & _
        ChkProg.Value & ", " & ChkReg.Value & ", " & ChkMaqAcid.Value & ", " & ChkGrAlim.Value & ", " & _
        ChkConjTecl.Value & ", " & ChkMaqTranc.Value & ", " & ChkPlBsEletr.Value & ", " & _
        ChkCjEntr.Value & ", " & ChkGrDis.Value & ", " & ChkGrImpr.Value & ", " & ChkCjEsc.Value & ", " & _
        ChkPint.Value & ", " & ChkRevGer.Value & ", " & ChkMon.Value & ", " & ChkCjLeit.Value & ", " & _
        ChkLubr.Value & ", " & ChkCjTab.Value & ", " & ChkCabImpr.Value & ", " & ChkDesm.Value & ", " & _
        ChkAlimEscr.Value & ", " & ChkLavTratFer.Value & ", " & ChkRevGrMot.Value & ", " & _
        ChkLacr.Value & ", " & ChkRetCilCar.Value & ", " & ChkRevEletr.Value & ", " & _
        ChkSolda.Value & ", " & ChkOutros.Value & ", '" & TxtCodPeca.Text & "', '" & TxtNomePeca.Text & "', " & _
        TxtQuant.Text & ", " & TxtValor.Text & ", " & TxtTotLinha.Text & "', '" & _
        TxtObs.Text & "', '" & _
        TxtDataTermServ.Text & "', '" & TxtHoraTermServ.Text & "');"
        .Execute
    End With
    MsgBox "Inclusão concluida com sucesso.", vbInformation + vbOKOnly + vbApplicationModal, "OK"
    LimparTela
    TxtNumOS.SetFocus
Saida:
    Set cnnComando = Nothing
    Exit Sub
errInclusao:
    With Err
        If .Number <> 0 Then
        MsgBox "Houve erro na inclusão dos dados na tabela.", vbExclamation + vbOKOnly + vbApplicationModal, "Erro"
        .Number = 0
        End If
    End With
End Sub

que eu acredito que seja porque deve estar mal sinalizado na sub??

 

Outra duvida é como que a tabela do Access vai entender que o um cliente pode utilizar mais de uma peça se os lançamentos na tabela ocorrem um a um???

 

se entenderam minhas duvidas aguardo ideias

agradeço.

Compartilhar este post

Link para o post
Compartilhar em outros sites

nereu1301    0

nereu1301
Postado

erro de sintaxe na instr insert into

 

seguinte

txtTotLinha surge daqui

 

Private Sub TxtTotLinha_GotFocus()

'Calcula a celula quantidade vezes valor peça e transf. em reais

TxtTotLinha.Text = Format(TxtValor.Text * TxtQuant.Text, "0.00")

End Sub

 

fiz um teste agora e percebi que o erro ocorre porque quando eu comando atraves do click os dados da linha passam para a flex e consequentemente fica vazia.

Compartilhar este post

Link para o post
Compartilhar em outros sites

nereu1301    0

nereu1301
Postado

nereu ficar dando UP no seu tópico é contra as regras, aguarde respostas.

 

Abraços...

 

 

 

Quintelab

nao foi essa minha intençao. Eu queria editar a mensagem que eu tinha mandado anteriormente poque achei que nao tinha ficado claro.

Valeu

mil desculpas!!

Compartilhar este post

Link para o post
Compartilhar em outros sites

Mário Monteiro    179

Mário Monteiro
Postado

e cade a parte do código que possui erro?

 

disse que é no insert into e colocou outra coisa

Compartilhar este post

Link para o post
Compartilhar em outros sites

nereu1301    0

nereu1301
Postado

e cade a parte do código que possui erro?

 

disse que é no insert into e colocou outra coisa

 

 

Bom dia pra voce tambem

o erro ocorre no incert into

Tenho 5 textbox que depois de preechidos eu clico no botao incluir e esses dados sao jogados no flex. Como um cliente pode usar diversas peças vou lançando essas peças uma a uma no grid e os textbox ficam vazios.

o erro Insert Into entao ocorre quando eu quero que essas peças do flex sejam incluidos na Tabela ref a essa oredem de serviço, que faço através do IncluirDados

pra isso uso as duas subs.

estou avaliando outra forma de fazer, indicado por amigos de outro forum e quando estiver resolvido eu posto o código

Compartilhar este post

Link para o post
Compartilhar em outros sites

Mário Monteiro    179

Mário Monteiro
Postado

post este insert aqui que fica mais simples de ver o que provoca o erro

Compartilhar este post

Link para o post
Compartilhar em outros sites

nereu1301    0

nereu1301
Postado

depois de muito trabalho e grande ajuda de meu camara Danikull, segue abaixo o codigo pra preencher uma msflexgrid e tabela acccess

 

Private Sub CmdSair_Click()
    Unload Me
    Set rsProdutos = Nothing
    Set rsConsertos1 = Nothing
End Sub
Private Sub txt_nr_LostFocus()
    txt_nr.Text = Format(txt_nr, "00000")
End Sub
Private Sub Form_Load()
    rsConsertos1.Open "Select * From Consertos1", Banco, 1, 2
    Set rsOficina1 = Nothing
    Preenche_GrdPecas
    OcultarControles
    CabecalhoGrid
    FormataLinha
    LerDados
End Sub
Private Sub FormataLinha()
Grid.TextMatrix(Grid.Rows - 1, 0) = Format(Grid.Rows - 1, "000")
End Sub
Private Sub Form_Resize()
    ' Reajustar o tamanho do grid ao formulario
    If WindowState <> vbMinimized Then
        Grid.Move 0, 3050, ScaleWidth, ScaleHeight
    End If
End Sub
Private Sub Grid_Click()
    ' Quando clicar uma vez
    ' atribui o valor selecionado
    AtribuiValorCelula
    AtualLinha = Grid.Row
    txt_verifica.SetFocus
End Sub
Private Sub Grid_DblClick()
    'editar ao clicar duas vezes
    LastRow = Grid.Row
    LastCol = Grid.Col
    OcultarControles
    ExibirCelula
End Sub
Private Sub Grid_KeyDown(KeyCode As Integer, Shift As Integer)
    ' Editar ao pressionar F2
    If KeyCode = vbKeyF2 Then
        ExibirCelula
    ElseIf KeyCode = vbKeyDelete Then
        ' Excluir linhas selecionadas
        ExcluirLinhas
    End If
End Sub
Private Sub Grid_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    ' Editar ao teclar ENTER
    Case vbKeyReturn
        KeyAscii = 0
        ExibirCelula
    ' Cancelar ao pressionar  ESC
    Case vbKeyEscape
        KeyAscii = 0
        AtribuiValorCelula
    ' Editar ao pressinar qualquer tecla
    Case 32 To 255
        ExibirCelula
        With Text1
            If .Visible Then
                .Text = Chr$(KeyAscii)
                .SelStart = Len(.Text) + 1
            End If
        End With
    End Select
End Sub
Private Sub Grid_Scroll()
    ' Ver se a coluna esta visivel
    ' entao ocultar os controles
    If Grid.ColIsVisible(LastCol) = False Then
        OcultarControles
        Exit Sub
    End If
    If Grid.RowIsVisible(LastRow) = False Then
        OcultarControles
        Exit Sub
    End If
    ' ver se estava visivel antes de ocultar
    ' e posicionar na mesma celula
    If ControlVisible Then
        ExibirCelula
    End If
End Sub
Private Sub ExibirCelula()
    Static Ok As Boolean
    ' Se for celula fixa , sair
    If Grid.Col <= Grid.FixedCols - 1 Or Grid.Row <= Grid.FixedRows - 1 Then
        Exit Sub
    End If
    If Ok Then Exit Sub
    Ok = True
    OcultarControles
    LastRow = Grid.Row
    LastCol = Grid.Col
    ' Nova Celula
    With Grid
        If .TextMatrix(LastRow, 0) = NovaLinha Then
            .Rows = .Rows + 1
            .TextMatrix(LastRow, 0) = LastRow
            .TextMatrix(.Rows - 1, 0) = NovaLinha
       End If
    End With
    '
    Select Case LastCol
    Case 0
        'Não faz nada
    Case 5
        'Não faz nada
    Case Else
        Text1.Move Grid.CellLeft - Screen.TwipsPerPixelX, Grid.CellTop + 3050 - Screen.TwipsPerPixelY, Grid.CellWidth + Screen.TwipsPerPixelX * 2, Grid.CellHeight + Screen.TwipsPerPixelY * 2
        Text1.Text = Grid.Text
        If Len(Grid.Text) = 0 Then
            If LastRow > 1 Then
                Text1.Text = Grid.TextMatrix(LastRow - 1, LastCol)
            End If
        End If
        Text1.Visible = True
        If Text1.Visible Then
            Text1.ZOrder
            Text1.SetFocus
        End If
    End Select
    ControlVisible = True
    Ok = False
End Sub
Private Sub ProximaCelula()
    If Grid.Col < Grid.Cols - 1 Then
        Grid.Col = Grid.Col + 1
    Else
        Grid.Col = 1
        If Grid.Row < Grid.Rows - 1 Then
            Grid.Row = Grid.Row + 1
        End If
    End If
End Sub
Private Sub Text1_GotFocus()
    With Text1
        ' Posiciona o cursor no fim do texto
        .SelStart = Len(.Text)
    End With
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim Row As Integer
    ' ao pressionar ENTER aceitar a entrada de dados
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        Select Case LastCol
            Case 1
                If Text1.Text <> "" Then
                    Set rsProdutos = New ADODB.Recordset
                        rsProdutos.Open "Select * From Produtos Where Referencia ='" & Text1.Text & "'", Banco, adOpenKeyset, adLockOptimistic
                            With rsProdutos
                                If .BOF = True And .EOF = True Then
                                    Msg = ""
                                    Msg = "** ERRO!! **" & vbNewLine & vbNewLine
                                    Msg = Msg & "Produto Não Localizado." & vbNewLine & vbNewLine
                                    Msg = Msg & "** AJUDA **" & vbNewLine & vbNewLine
                                    Msg = Msg & "Informe o código de um produto ja cadastrado" & vbNewLine
                                    Msg = Msg & "ou realize uma consulta ao produtos cadastrados." & vbNewLine & vbNewLine
                                    MsgBox Msg, vbCritical, "ERRO - Produto Não Cadastro"
                                        Text1.SetFocus
                                        Call SelectTextControl(Text1)
                                        Exit Sub
                                Else
                                    Grid.TextMatrix(Grid.Row, 2) = !Descricao
                                End If
                            End With
                End If
            Case 4
                If Grid.TextMatrix(Grid.Row, 3) <> "0,00" Then
                    Grid.TextMatrix(Grid.Row, 5) = Format(CDbl(Text1.Text) * CDbl(Grid.TextMatrix(Grid.Row, 3)), "#,##0.00")
                    Row = 0
                    TxtTotPecas.Text = Format(0, "#,##0.00")
                    Do Until Row = Grid.Rows - 2
                        Row = Row + 1
                        TxtTotPecas.Text = Format(CDbl(TxtTotPecas.Text) + CDbl(Grid.TextMatrix(Row, 5)), "#,##0.00")
                    Loop
                End If
            Case 5
                If Grid.TextMatrix(Grid.Row, 4) <> "0,00" Then
                    Grid.TextMatrix(Grid.Row, 5) = Format(CDbl(Grid.TextMatrix(Grid.Row, 3)) * CDbl(Text1.Text), "#,##0.00")
                    Row = 0
                    TxtTotPecas.Text = Format(0, "#,##0.00")
                    Do Until Row = Grid.Rows - 2
                        Row = Row + 1
                        TxtTotPecas.Text = Format(CDbl(TxtTotPecas.Text) + CDbl(Grid.TextMatrix(Row, 5)), "#,##0.00")
                    Loop
                End If
        End Select
        AtribuiValorCelula
        ProximaCelula
    ' ESC, cancela a edição
    ElseIf KeyAscii = vbKeyEscape Then
        KeyAscii = 0
        Text1.Visible = False
        ControlVisible = False
    End If
End Sub
Private Sub AtribuiValorCelula()
    Dim Texto As String
    OcultarControles
    ControlVisible = False
    ' atribuir o texto anterior a celula
    Select Case LastCol
        Case 3
            'notas menores que 5 muda cor fonte para vermelho, demais azul
            Texto = Text1.Text
            Grid.TextMatrix(LastRow, LastCol) = Format(Texto, "#,##0.000")
        Case 4
            Texto = Text1.Text
            Grid.TextMatrix(LastRow, LastCol) = Format(Texto, "#,##0.00")
        Case Else
            Texto = Text1.Text
            Grid.TextMatrix(LastRow, LastCol) = Texto
    End Select
End Sub
Private Sub CabecalhoGrid()
    ' configuar o grid
    Dim i As Long
    With Grid
        .GridLines = flexGridFlat
        .FixedRows = 1
        .FixedCols = 0
        .ScrollBars = flexScrollBarBoth
        .AllowUserResizing = flexResizeColumns
        .Cols = 6                   ' Número de colunas(incluindo o cabecalho)
        .Rows = 2                   ' Número de linhas(com cabecalho)
        .TextArray(0) = "Item"
        .ColWidth(0) = 450
        .ColAlignment(0) = 3
        .TextArray(1) = "Código"
        .ColWidth(1) = 1000
        .ColAlignment(1) = 2
        .TextArray(2) = "Descrição"
        .ColWidth(2) = 5750
        .ColAlignment(2) = 2
        .TextArray(3) = "Quantidade"
        .ColWidth(3) = 950
        .ColAlignment(3) = 2
        .TextArray(4) = "Vlr Unit"
        .ColWidth(4) = 1400
        .ColAlignment(4) = 7
        .TextArray(5) = "Vlr Total"
        .ColWidth(5) = 1400
        .ColAlignment(5) = 7
        ' Mostrar os números nas colunas
        For i = 1 To .Rows - 1
            .TextMatrix(i, 0) = i
        Next
        ' Indica uma nova linha
        ' atribui a primeira linha do grid
        .TextMatrix(.Rows - 1, 0) = NovaLinha
    End With
End Sub
Private Sub ExcluirLinhas()
    ' Excluir linhas selecionadas
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim n As Long
    ' Não excluir se for a ultima linha
    If Grid.RowSel = Grid.Rows - 1 Then
        Beep
        Exit Sub
    End If
    If Grid.Row = Grid.Rows - 1 Then
        Beep
        Exit Sub
    End If
    ' Exclui sempre da linha maior par menor
    i = Grid.Row
    j = Grid.RowSel
    If i < j Then
        k = i
        i = j
        j = k
    End If
    For n = i To j Step -1
        Grid.RemoveItem n
    Next
    LastRow = Grid.Rows - 1
    LastCol = 1
    Grid.Col = LastCol
    Grid.Row = LastRow
    Grid.RowSel = LastRow
    Grid.ColSel = LastCol
End Sub
Private Sub OcultarControles()
    ' Ocultar o controle textbox
    Text1.Visible = False
End Sub
Private Sub LerDados()
    ' Ler dados e preencher o grid
    With Grid
        .TextMatrix(.Rows - 1, 0) = NovaLinha
        LastRow = .Rows - 1
        LastCol = 1
        .Col = LastCol
        .Row = LastRow
        .RowSel = LastRow
        .ColSel = LastCol
    End With
End Sub
Private Sub tmr_1_Timer()
    If GetAsyncKeyState(Press_UP) Then
        CimaPress = True
        txt_verifica.SetFocus
    ElseIf GetAsyncKeyState(Press_DOWN) Then
        BaixoPress = True
        txt_verifica.SetFocus
    ElseIf GetAsyncKeyState(Press_RIGHT) Or GetAsyncKeyState(Press_LEFT) Then
        'as Setas para direita e para esquerda não serão usadas
    End If
End Sub
Private Sub txt_verifica_GotFocus()
If CimaPress = True Then
    If UltimaLinha - 1 <> 0 Then
        Grid.Col = 0
        Grid.Row = UltimaLinha
        For Cont = 0 To Grid.Cols - 1
            Grid.Col = Cont
            Grid.Row = UltimaLinha
            Grid.CellBackColor = &H80000005 'branco
            Grid.CellForeColor = &H80000008 'preto
        Next
    End If
    Grid.Row = UltimaLinha - 1
    If Grid.CellBackColor = &H80000005 Or Grid.CellBackColor = 0 Then
        For Cont = 0 To Grid.Cols - 1
            Grid.Col = Cont
            Grid.Row = Grid.Row
            Grid.CellBackColor = &H8000000D 'azul
            Grid.CellForeColor = &H80000005 'banco
        Next
    End If
    Grid.Col = 0
    Grid.Row = Grid.Row
    Grid.SetFocus
    CimaPress = False
ElseIf BaixoPress = True Then
    If UltimaLinha + 1 <> Grid.Rows Then
        Grid.Col = 0
        Grid.Row = UltimaLinha
        For Cont = 0 To Grid.Cols - 1
            Grid.Col = Cont
            Grid.Row = UltimaLinha
            Grid.CellBackColor = &H80000005 'branco
            Grid.CellForeColor = &H80000008 'preto
        Next
    End If
    Grid.Col = 0
    Grid.Row = UltimaLinha + 1
    If Grid.CellBackColor = &H80000005 Or Grid.CellBackColor = 0 Then
        For Cont = 0 To Grid.Cols - 1
            Grid.Col = Cont
            Grid.Row = Grid.Row
            Grid.CellBackColor = &H8000000D 'azul
            Grid.CellForeColor = &H80000005 'banco
        Next
    End If
    Grid.Col = 0
    Grid.Row = Grid.Row
    Grid.SetFocus
    BaixoPress = False
ElseIf ClicMouse = True Then
    '    For Cont = 0 To Grid.Cols - 1
    '        Grid.Col = Cont
    '        Grid.Row = UltimaLinha
    '        Grid.CellBackColor = vbWhite ' Branco
    '        Grid.CellForeColor = vbBlack  ' Preto
    '    Next
    '    Grid.Col = 0
    '    Grid.Row = AtualLinha
    Grid.SetFocus
    ClicMouse = False
End If
End Sub
Private Sub NewIdITens()
Dim NewId As String
With rsConsertos1
    If .EOF = True And .BOF = True Then
        NewId = 1
    Else
        .MoveLast
        NewId = !Itens_nr + 1
    End If
    IdItens = ""
    IdItens = Format(NewId, "00000")
End With
End Sub
Private Sub Incluir()
On Erro GoTo errInclusao
NewRecord = True
Dim Row As Integer
Msg = ""
Msg = Msg & " ** AVISO ** " & vbNewLine & vbNewLine
Msg = Msg & "Esta é uma operação para " & ButtonClicked & " de registros!!!" & vbNewLine
Msg = Msg & "Você confirma a " & ButtonClicked & " deste Registro???" & vbNewLine & vbNewLine
If MsgBox(Msg, vbExclamation + vbYesNo, ButtonClicked & " de Resgistros") = vbYes Then
    With rsConsertos1
        Do Until Row = Grid.Rows - 2
            Call NewIdITens
            Row = Row + 1
            Grid.Col = 0
            Grid.Row = Row
            If Grid.CellBackColor <> CDbl(&HC0C0C0) Then
                'esta é outra forma
                'With cnnComando
                    '.ActiveConnection = Banco
                    '.CommandType = adCmdText
                    'cria o modulo sql
                    '.CommandText = "INSERT INTO Consertos1" & _
                    '"(Itens_nr, Numero_OS, Item, CodPeca, NomePeca, Quant, Valor, TotLinha) Values('" & _
                    'IdItens & "', '" & txt_nr.Text & "', " & _
                    'Grid.TextMatrix(Row, 0) & ", " & Grid.TextMatrix(Row, 1) & ", '" & Grid.TextMatrix(Row, 2) & "', " & _
                    'Grid.TextMatrix(Row, 3) & ", " & Grid.TextMatrix(Row, 4) & ", " & Grid.TextMatrix(Row, 5) & ");"
                    '.Execute
                'End With
                If NewRecord = True Then .AddNew
                    !Itens_nr = IdItens
                    !Numero_OS = txt_nr.Text
                    !Item = Grid.TextMatrix(Row, 0)
                    !CodPeca = Grid.TextMatrix(Row, 1)
                    !NomePeca = Grid.TextMatrix(Row, 2)
                    !Quant = Grid.TextMatrix(Row, 3)
                    !valor = Grid.TextMatrix(Row, 4)
                    !TotLinha = Grid.TextMatrix(Row, 5)
                    !Totpecas = TxtTotPecas.Text
                .Update
                .Requery
            End If
        Loop
    End With
End If
errInclusao:
    With Err
        If .Number <> 0 Then
        MsgBox "Houve erro na inclusão dos dados na tabela.", vbExclamation + vbOKOnly + vbApplicationModal, "Erro"
        .Number = 0
        End If
    End With
End Sub

obrigado pela paciencia e se alguem puder finalizar o post agradeço

nreu

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Visual Basic
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito