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

Português do Brasil
, , , ,
#1

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.

#2

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

#3

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.Visible=True
	oCampo_numerico_3.Visible=True
	y = oLicencas.Value
	w = CInt (y)
	oCampo_numerico_1.Value = w
	
	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(w) - 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)

endif

		

		Form1.Requery

'print z

End Sub

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

No LibreOffice Base

Sub btn_incluir

Dim Form1, oConsulta, cmb_codhw, cmb_softw As Object, sSQL As String

Set Form1=Forms("frm_licenca_hw")
cmb_codhw=Form1.Controls("txtMicro")
cmb_softw=Form1.Controls("txtSoftware")
oConsulta = ThisDatabaseDocument.DataSource.QueryDefinitions.getByName ("cons_subtab_licenca_hw")
sSQL = "INSERT INTO `c06`.`tab_licenca` (`cod_hw`, `software`) VALUES ('" & cmb_codhw.Value & "','" & cmb_softw.Value & "');"
RunSQL(sSQL)
oConsulta.Command = "SELECT DISTINCT `cod_hw`, `software` FROM `c06`.`tab_licenca` AS `tab_licenca` WHERE `cod_hw` = '" & cmb_codhw.Value & "' ORDER BY `cod_hw` ASC, `software` ASC"
cmb_softw.Value=""
Form1.Requery

End Sub

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

No LibreOffice Base

Sub fechaForms

REM Macro generica para fechar qualquer forms
StarDesktop.CurrentComponent.CurrentController.Frame.close( true )
End Sub

Espero ter ajudado…

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.