Guru do Excel e Power BI

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

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