Este fórum está sendo desativado

[JCabral]

Caro Osvaldopm

A parte de Selecionar/Desselecionar já está a funcionar direito, tive a ajuda de um colega aqui do forum - eduardogrigull.

Fica a faltar a parte da escrita dos dados na BD, que você disse que poderia ajudar.
Na altura da escrita/gravação a única confirmação a fazer é que para cada DF/FO escolhido tem que haver uma percentagem associada, se não houver, sai mensagem e o foco tem que ficar na respectiva ComboBox.
A escrita/gravação será pelo idCodAtv que está na na primeira coluna da ListBox1.

Obrigado
Jorge Cabral

[JCabral]

Alguma ajuda?

[eduardogrigull]

Tenta isso no botão Gravar na BD...

Código: Selecionar todos

Private Sub cmdGravar_Click()
'
'   Grava dados em BDBACK - IMPLEMENTAR EM SQL
'


'Procurar o nome da tarefa na planilha
    Dim LinhaTarefa As Long
    Dim i As Long
    i = 2
    
    Do While LinhaTarefa = Empty
        If BDBACK.Cells(i, 2).Value = ListBox1.Text Then
            LinhaTarefa = i
        Else
            i = i + 1
        End If
        If i > BDBACK.Cells(BDBACK.Rows.Count, 2).End(xlUp).Row Then
            GoTo Erro
        End If
    Loop
    
    If LinhaTarefa = Empty Then
        MsgBox "Tarefa nao cadastrada"
        Exit Sub
    End If

'Verificar os lbl e combobox
    For j = 0 To 5
        If RECURSOS.Controls("lblRec" & j).Caption <> Empty And RECURSOS.Controls("ComboBox" & j).Value = Empty Then
            GoTo ValoresIncorretos
        End If
    Next

'Cadastro

'Apagar registros antigos
    For j = 15 To 26
        BDBACK.Cells(LinhaTarefa, j).Value = Empty
    Next

'Gravar novos registros
    For k = 0 To 5
        If RECURSOS.Controls("lblRec" & k).Caption <> Empty Then
            BDBACK.Cells(LinhaTarefa, 15 + (k * 2)).Value = RECURSOS.Controls("lblRec" & k).Caption
            BDBACK.Cells(LinhaTarefa, 16 + (k * 2)).Value = RECURSOS.Controls("ComboBox" & k).Value
        End If

    Next k


Exit Sub
ValoresIncorretos:

MsgBox "Digite as %%%% ", vbExclamation

Exit Sub
Erro:

MsgBox "Erro"
End Sub

[JCabral]

Eduardogrigull, obrigado pela sua versão, vou testar.

É possível fazer esse update em SQL?

[eduardogrigull]

Eu não faço ideia, nunca trabalhei com SQL

[JCabral]

Ok obrigado, vou ver se alguém dá uma ajuda com SQL

[JCabral]

Adaptei uma instrução de código em SQL que encontrei na internet para o meu caso mas está a dar erro quando os valores são Nulos/Empty.

Como posso ultrapassar esta situação?

Código: Selecionar todos

Private Sub cmdGravar_Click()
'
'   Grava dados em BDBACK - IMPLEMENTAR EM SQL
'
    Dim Dataread As ADODB.Recordset
    Dim Sql As String
    
    Dim Var0 As Double
    Dim Var1 As String, Var2 As Variant
    Dim Var3 As String, Var4 As Variant
    Dim Var5 As String, Var6 As Variant
    Dim Var7 As String, Var8 As Variant
    Dim Var9 As String, Var10 As Variant
    Dim Var11 As String, Var12 As Variant
    
'Verificar os Labels e as ComboBox
    For i = 0 To 5
        If RECURSOS.Controls("lblRec" & i).Caption <> Empty And RECURSOS.Controls("ComboBox" & i).Value = Empty Then
            RECURSOS.Controls("ComboBox" & i).SetFocus
            MsgBox "É necessário digitar a percentagem para o " & RECURSOS.Controls("lblRec" & i).Caption
            Exit Sub
        End If
    Next

' Inicializa Valores das variaveis

    Var0 = Me.ListBox1.List(ListBox1.ListIndex, 0)
    
    Var1 = RECURSOS.Controls("lblRec0").Caption
    If RECURSOS.Controls("ComboBox0").Value <> Empty Then Var2 = RECURSOS.Controls("ComboBox0").Value / 100
    Var3 = RECURSOS.Controls("lblRec1").Caption
    If RECURSOS.Controls("ComboBox1").Value <> Empty Then Var4 = RECURSOS.Controls("ComboBox1").Value / 100
    
    Var5 = RECURSOS.Controls("lblRec2").Caption
    If RECURSOS.Controls("ComboBox2").Value <> Empty Then Var6 = RECURSOS.Controls("ComboBox2").Value / 100
    Var7 = RECURSOS.Controls("lblRec3").Caption
    If RECURSOS.Controls("ComboBox3").Value <> Empty Then Var8 = RECURSOS.Controls("ComboBox3").Value / 100
    Var9 = RECURSOS.Controls("lblRec4").Caption
    If RECURSOS.Controls("ComboBox4").Value <> Empty Then Var10 = RECURSOS.Controls("ComboBox4").Value / 100
    Var11 = RECURSOS.Controls("lblRec5").Caption
    If RECURSOS.Controls("ComboBox5").Value <> Empty Then Var12 = RECURSOS.Controls("ComboBox5").Value / 100
    
    Sql = "UPDATE [BDBACK$] SET"
    Sql = Sql & " [BDBACK$].[idDF1] = '" & Var1 & "', "
    Sql = Sql & " [BDBACK$].[PercDF1] = '" & Var2 & "' ,"
    Sql = Sql & " [BDBACK$].[idDF2] = '" & Var3 & "' ,"
    Sql = Sql & " [BDBACK$].[PercDF2] = '" & Var4 & "' ,"
    Sql = Sql & " [BDBACK$].[idFO1] = '" & Var5 & "' ,"
    Sql = Sql & " [BDBACK$].[PercFO1] = '" & Var6 & "' ,"
    Sql = Sql & " [BDBACK$].[idFO2] = '" & Var7 & "' ,"
    Sql = Sql & " [BDBACK$].[PercFO2] = '" & Var8 & "' ,"
    Sql = Sql & " [BDBACK$].[idFO3] = '" & Var9 & "' ,"
    Sql = Sql & " [BDBACK$].[PercFO3] = '" & Var10 & "' ,"
    Sql = Sql & " [BDBACK$].[idFO4] = '" & Var11 & "' ,"
    Sql = Sql & " [BDBACK$].[PercFO4] = '" & Var12 & "'"
    Sql = Sql & " WHERE [BDBACK$].[idCodAtv] = " & Var0 & " ;"
    
    Set Dataread = New ADODB.Recordset
    Cx.Conectar
    
    With Dataread
        .Source = Sql
        .ActiveConnection = Cx.Conn
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .LockType = adLockReadOnly
        .Open
    End With
    
    Cx.Desconectar

End Sub


Obrigado

[JCabral]

Alguma ajuda?

[JCabral]

Alguém me saberá dizer se ao menos é possível fazer o que pretendo, em VBA?

Obrigado
Jorge Cabral

[JCabral]

Solução encontrada.