Pergunte aqui
0

Como recriar esta macro do VBA / MSAccess para o OoBasic do LibreOffice Base?

perguntadas 2015-03-18 19:10:10 +0200

esta mensagem está marcada como wiki comunitário

Esta mensagem é um wiki. Qualquer pessoa com karma >75 é bem-vinda para a melhorar.

Fala galera, to tentando migrar um bd de Access para Base, mas possui macro VBA e nunca vi material na net que ensinasse o OooBasic, ele não tem o recurso que o access tinha de ao digitar o "." ponto) abrir uma janela com métodos e propriedades que a gente podia usar ali no controle. segue o código.

Private Sub btnExcluir_Click()
On Error GoTo Err_btnExcluir_Click

   Dim item As Variant
   Dim S As String
   Dim M As String

   For Each item In lstSoftware.ItemsSelected
      S = "'" & lstSoftware.ItemData(item) & "'"
      M = "'" & txtMicro & "'"
      DoCmd.RunSQL ("DELETE * FROM licenca " _
                  & "WHERE cod_hw = " & M & " AND software = " & S & ";")
    Next item

   lstSoftware.Requery

Exit_btnExcluir_Click:
   Exit Sub

Err_btnExcluir_Click:
   MsgBox "Exclusão Cancelada"
   Resume Exit_btnExcluir_Click
End Sub
Private Sub btnIncluir_Click()
On Error GoTo Err_btnIncluir_Click

    DoCmd.RunSQL ("INSERT INTO licenca (cod_hw,software) " _
                 & "VALUES (txtMicro, txtSoftware);")
    txtSoftware = ""
    lstSoftware.Requery

Exit_btnIncluir_Click:
    Exit Sub

Err_btnIncluir_Click:
    MsgBox ("Inclusão Cancelada")
    Resume Exit_btnIncluir_Click

End Sub

Private Sub txtMicro_AfterUpdate()
   lstSoftware.Requery
End Sub

Private Sub txtMicro_Change()

End Sub
Private Sub btnFechar_Click()
On Error GoTo Err_btnFechar_Click

    DoCmd.Close

Exit_btnFechar_Click:
    Exit Sub

Err_btnFechar_Click:
    MsgBox Err.Description
    Resume Exit_btnFechar_Click

End Sub

------------------------------------------------------------------------------------

Option Compare Database
Option Explicit
Private Sub btnFechar_Click()
On Error GoTo Err_btnFechar_Click

    DoCmd.Close

Exit_btnFechar_Click:
    Exit Sub

Err_btnFechar_Click:
    MsgBox Err.Description
    Resume Exit_btnFechar_Click

End Sub

Private Sub txtSoftware_AfterUpdate()
   lstMicro.Requery
   txtLic = txtSoftware.Column(1)
   txtInst = lstMicro.ListCount
   If IsNumeric(txtLic) Then
      txtSaldo = txtLic - txtInst
    Else
       txtSaldo = ""
    End If
End Sub

------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

Private Sub txtMicro_AfterUpdate()
   lstSoftware.Requery
End Sub

Private Sub txtMicro_Change()


End Sub
Private Sub btnFechar_Click()
On Error GoTo Err_btnFechar_Click

    DoCmd.Close

Exit_btnFechar_Click:
    Exit Sub

Err_btnFechar_Click:
    MsgBox Err.Description
    Resume Exit_btnFechar_Click

End Sub


-----------------------------------------------------------------------

Por favor esse código em VBA em compreendo, mas não sei nada na sintaxe do OoBasic, as macros em Basic são completamente malucas pq não sei como é a API UNO do Libre.

editar alterar tag assinalar como ofensivo fechar mesclar Excluir

2 Respostas

1

respondidas 2015-03-20 14:16:24 +0200

imagem do gravatar de Grafeno

A extensão Access2Base simplifica, e muito, a API UNO dentro LibreOffice Base. E ao que parece, pelos exemplos, a sintaxe fica bem próxima àquela utilizada no Ms Access.

A partir da versão 4.2 do LibreOffice, essa extensão foi incorporada. Para fazer uso de seus recursos basta colar a instrução abaixo no começo do módulo:

Sub DBOpen(Optional poEvent As Object)
   If GlobalScope.BasicLibraries.hasByName("Access2Base") then GlobalScope.BasicLibraries.LoadLibrary("Access2Base")
   Call OpenConnection(ThisDatabaseDocument)
End Sub

Os objetos, métodos, propriedades, etc. estão descritos (em inglês) na página de ajuda do projeto Access2Base.

Atte,
Grafeno

editar assinalar como ofensivo Excluir Link mais
1

respondidas 2015-06-07 23:36:52 +0200

imagem do gravatar de LuizCarlos18RJ

Após muita pesquisa vai a conversão:

Private Sub btnExcluir_Click() ( vide o código completo na pergunta principal - VBA )

No LibreOffice Base

Sub btn_excluir_sw_all

Dim Form1, SubForm_1, oConsulta, cmb_softw, cons_subtab As Object, sSQL1, sSQL2 As String

Set Form1=Forms("frm_licenca_sw")
Set SubForm_1 = Form1.Controls("Subform")
Set cons_subtab = SubForm_1.form.Controls("Controle_de_tabela_1")
Set cmb_softw=Form1.Controls("txtSoftware")
oConsulta = ThisDatabaseDocument.DataSource.QueryDefinitions.getByName ("cons_subtab_licenca_sw")
sSQL1 = ("DELETE FROM `c06`.`tab_licenca` WHERE `software` = '" & cmb_softw.Value & "';")
sSQL2 = ("DELETE FROM `c06`.`tab_software` WHERE `nome` = '" & cmb_softw.Value & "';")
RunSQL(sSQL1)
RunSQL(sSQL2)
cmb_softw.Value=""
'Form1.Requery
atualiza_form_sw

End Sub 

Private Sub txtMicro_AfterUpdate() e Private Sub txtSoftware_AfterUpdate() ( vide o código completo na pergunta principal - VBA )

No LibreOffice Base

Sub atualiza_form_licenca_sw
'---DECLARA VARIÁVEIS---------------------------------------------

Dim Form1, oConsulta, oConsulta2, cmb_codsw, SubForm_1, SubForm_2, cons_subtab,cons_subtab2, oLicencas, oUtilizadas, oCampo_numerico_1, oCampo_numerico_2, oCampo_numerico_3, label_1, label_2 As Object, x, y, r, w, z as integer, sSQL as String

'---SETA VARIÁVEIS A OBJETOS DO FORMULÁRIO------------------------

Set Form1=Forms("frm_licenca_sw")
cmb_codsw=Form1.Controls("txtSoftware")
oCampo_numerico_1 = Form1.Controls("Campo numérico 1")
oCampo_numerico_2 = Form1.Controls("Campo numérico 2")
oCampo_numerico_3 = Form1.Controls("Campo numérico 3")
label_1 = Form1.Controls("Caixa de texto 1")
label_2 = Form1.Controls("Caixa de texto 2")

'---SETA VARIÁVEIS A OBJETOS DOS SUBFORMULÁRIOS NO FORM PRINCIPAL--

Set SubForm_1 = Form1.Controls("Subform")
Set cons_subtab = SubForm_1.form.Controls("Controle_de_tabela_1")
Set  oLicencas = cons_subtab.Controls("TextField3")
'----------------------------------------------------------
Set SubForm_2 = Form1.Controls("Subform2")
Set cons_subtab2 = SubForm_2.form.Controls("Controle_de_tabela_2")
Set oUtilizadas = cons_subtab2.Controls("TextField1")

'---SETA VARIÁVEIS A OBJETOS DO BANCO DE DADOS------------------------

oConsulta = ThisDatabaseDocument.DataSource.QueryDefinitions.getByName ("cons_subtab_licenca_sw")
oConsulta2 = ThisDatabaseDocument.DataSource.QueryDefinitions.getByName ("cons_contar_subtab_licenca_sw")

'---EXECUTA INSTRUÇÕES SQL NAS CONSULTAS------------------------

oConsulta.Command = "SELECT DISTINCT `tab_licenca`.`cod_hw`, `tab_licenca`.`software`, `tab_software`.`total_licencas_adquiridas`, `tab_software`.`licencas_restantes` FROM `c06`.`tab_licenca` AS `tab_licenca`, `c06`.`tab_software` AS `tab_software` WHERE `tab_licenca`.`software` = `tab_software`.`nome` AND `tab_licenca`.`software` = '" & cmb_codsw.Value & "' ORDER BY `tab_licenca`.`cod_hw` ASC, `tab_licenca`.`software` ASC"

oConsulta2.Command = "SELECT COUNT(`software`) FROM `cons_subtab_licenca_sw`"

'---INICIO--------------------------------------

Form1.Requery

if oLicencas.Value="Livre" then 'Trata Valor texto em campo numérico

    label_1.Visible=True
    label_2.Visible=True
    oCampo_numerico_1.Visible=False
    oCampo_numerico_3.Visible=False

        if IsEmpty (oUtilizadas.Value)  then  'Trata valores Nulos
                oCampo_numerico_2.Value = 0

            else                                  
                    x = oUtilizadas.Value
                    z = CInt (x)
                    oCampo_numerico_2.Value = z
        endif

    sSQL = "UPDATE `c06`.`tab_software` SET `licencas_restantes` = ('Livre') WHERE `nome` = ('" & cmb_codsw.Value & "');"
    RunSQL(sSQL)

elseif IsEmpty (oLicencas.Value)  then 'Trata valores Nulos

    label_1.Visible=False
    label_2.Visible=False
    oCampo_numerico_1.Visible=True
    oCampo_numerico_3.Visible=True
    y = 0
    oCampo_numerico_1.Value = y

    if IsEmpty (oUtilizadas.Value)  then  'Trata valores Nulos
            oCampo_numerico_2.Value = 0
        else        

            x = oUtilizadas.Value
            z = CInt (x)
            oCampo_numerico_2.Value = z
    endif

    r = CInt(y) - CInt(z) 

    if r > 0 then                          'Altera cor da fonte da caixa de texto condicionalmente para alertar sobre valores

                oCampo_numerico_3.ForeColor = RGB(0, 0, 192) 'Azul
        elseif  r = 0 then 
                oCampo_numerico_3.ForeColor = RGB(0, 0, 0)   'Preto
        else
                oCampo_numerico_3.ForeColor = RGB(255, 0, 0) 'Vermelho
    endif

        oCampo_numerico_3.Value = r             'Resultado final da qtd de licenças disponíveis exibida na caixa de texto.

sSQL = "UPDATE `c06`.`tab_software` SET `licencas_restantes` = ('" & oCampo_numerico_3.Value & "') WHERE `nome` = ('" & cmb_codsw.Value & "');"
RunSQL(sSQL)

else  'Converte variáveis para números afins de execução de cálculos 

    label_1.Visible=False
    label_2.Visible=False
    oCampo_numerico_1 ...
(mais)
editar assinalar como ofensivo Excluir Link mais
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2015-03-18 19:10:10 +0200

Lidas: 709 vezes

Última atualização: Jun 07 '15