[SOLVED] Przekonwertowanie makra VBA na Libreoffice

Makropolecenia i funkcje w języku Basic
piotrdw
Posty: 4
Rejestracja: śr paź 09, 2013 9:48 am

[SOLVED] Przekonwertowanie makra VBA na Libreoffice

Post autor: piotrdw »

Witam
Mam problem z jednym makrem którego niestety nie mogę przekonwertować na libreoffice. Makro jest napisane przez informatyków w firmie z którą współpracuję i niestety nie mam możliwości z nimi się skontaktować. Makro to jest niezbędne do prawidłowego zaksięgowania kwot w banku a zależy mi aby używać go w libreoffice a nie w excelu. Pracuję na Kubuntu 11.10 o ile ma to jakieś znaczenie.

Zaznaczam, że makro działało w wersji libreoffice3,6 natomiast wysypuje się w wersji 4.1. Makro to zapisuje dane do pliku o rozszerzeniu csv. Problem pojawia się przy nadaniu nazwy pliku.

Kod: Zaznacz cały

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
Const SEPARATOR_POL As String = ","
Const SEPARATOR_NAZ As String = "_"
Const FORMAT_DATY As String = "YYYYMMDD"
Const FORMAT_CZASU As String = "HHMMSS"
Const FORMAT_KWOTY As String = "0.00"


Public Sub ZapiszDaneJakoCSV()
On Local Error GoTo ZapiszDaneJakoCSV_ErrH

  Dim mess As String
  Dim nazwaPliku As String
  Dim np As Long
  Dim r As Long, i As Long
  Dim linia As String, wartoscJakoString As String
  Dim sk As Long
  
  If ActiveWorkbook.ActiveSheet.Range("B2").Value = "" Then mess = mess & vbCrLf & " - brak numeru agenta"
  If ActiveWorkbook.ActiveSheet.Range("C2").Value = "" Then mess = mess & vbCrLf & " - brak kwoty wpłaty zbiorczej"
  If ActiveWorkbook.ActiveSheet.Range("D2").Value = "" Then mess = mess & vbCrLf & " - brak daty dokonania wpłaty zbiorczej"
  If ActiveWorkbook.ActiveSheet.Range("G12").Value <> "" Then mess = mess & vbCrLf & " - niespełniony warunek zgodności kwoty zbiorczej z sumą kwot transakcji!"
  
  
  For r = 4 To 1000
    If ((ActiveWorkbook.ActiveSheet.Cells(r, 1) <> "") Or (ActiveWorkbook.ActiveSheet.Cells(r, 2) <> "") Or (ActiveWorkbook.ActiveSheet.Cells(r, 3) <> "") Or (ActiveWorkbook.ActiveSheet.Cells(r, 4) <> "")) And Not ((ActiveWorkbook.ActiveSheet.Cells(r, 1) <> "") And (ActiveWorkbook.ActiveSheet.Cells(r, 2) <> "") And (ActiveWorkbook.ActiveSheet.Cells(r, 3) <> "") And (ActiveWorkbook.ActiveSheet.Cells(r, 4) <> "")) Then mess = mess & vbCrLf & " - niekompletne dane w wierszu " & CStr(r)
  Next r
  
  
  If mess <> "" Then
    MsgBox "Przed zapisaniem pliku proszę poprawić następujące błędy:" & vbCrLf & mess, vbOKOnly + vbExclamation, "Błąd"
    Exit Sub
  End If
   
   nazwaPliku = Application.GetSaveAsFilename(ActiveWorkbook.ActiveSheet.Cells(2, 2) & SEPARATOR_NAZ & Format(ActiveWorkbook.ActiveSheet.Cells(2, 4), FORMAT_DATY) & SEPARATOR_NAZ & (ActiveWorkbook.ActiveSheet.Cells(2, 19)) & "PLN" & SEPARATOR_NAZ & Format(Date, FORMAT_DATY) & SEPARATOR_NAZ & Format(Time(), FORMAT_CZASU), "Pliki z wartościami rozdzielanymi przecinkami (*.csv), *.csv", 0, "Wskaż gdzie i pod jaką nazwą zapisać plik")
  
np = FreeFile
  
  Open nazwaPliku For Output As np
  
    
  Print #np, ActiveWorkbook.ActiveSheet.Cells(2, 1) & SEPARATOR_POL & ActiveWorkbook.ActiveSheet.Cells(2, 2) & SEPARATOR_POL & KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(2, 3), FORMAT_KWOTY)) & SEPARATOR_POL & Format$(ActiveWorkbook.ActiveSheet.Cells(2, 4), FORMAT_DATY)
      
  sk = 13
  
  wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(2, 1))
  For i = 1 To Len(wartoscJakoString)
    sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
  Next i

  wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(2, 2))
  For i = 1 To Len(wartoscJakoString)
    sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
  Next i

  wartoscJakoString = KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(2, 3), FORMAT_KWOTY))
  For i = 1 To Len(wartoscJakoString)
    sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
  Next i
  
  wartoscJakoString = Format$(ActiveWorkbook.ActiveSheet.Cells(2, 4), FORMAT_DATY)
  For i = 1 To Len(wartoscJakoString)
    sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
  Next i
  
  For r = 4 To 1000
    If ActiveWorkbook.ActiveSheet.Cells(r, 1) & SEPARATOR_POL & ActiveWorkbook.ActiveSheet.Cells(r, 2) & SEPARATOR_POL & ActiveWorkbook.ActiveSheet.Cells(r, 3) & SEPARATOR_POL & ActiveWorkbook.ActiveSheet.Cells(r, 4) <> SEPARATOR_POL & SEPARATOR_POL & SEPARATOR_POL Then
      linia = ActiveWorkbook.ActiveSheet.Cells(r, 1) & SEPARATOR_POL & ActiveWorkbook.ActiveSheet.Cells(r, 2) & SEPARATOR_POL & KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(r, 3), FORMAT_KWOTY)) & SEPARATOR_POL & Format$(ActiveWorkbook.ActiveSheet.Cells(r, 4), FORMAT_DATY)
      Print #np, linia
    
      wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(r, 1))
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i
    
      wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(r, 2))
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i
    
      wartoscJakoString = KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(r, 3), FORMAT_KWOTY))
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i
      
      wartoscJakoString = Format$(ActiveWorkbook.ActiveSheet.Cells(r, 4), FORMAT_DATY)
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i
    
    End If
  Next r
  

  Print #np, CStr(sk)
  
  Close np
  
  ActiveWorkbook.Saved = True
  
  MsgBox "Dziękujemy, dane zostały pomyślnie zapisane do pliku " & nazwaPliku & vbCrLf & "Prosimy o przesłanie tego pliku do Banku według uzgodnionej procedury.", vbInformation + vbOKOnly
Exit Sub

ZapiszDaneJakoCSV_ErrH:
  Close
  MsgBox "Zapis danych do pliku " & nazwaPliku & " nie powiódł się!" & vbCrLf & "Proszę sprawdzić czy na dysku jest wystarczająca ilość wolnego miejsca oraz czy nie jest zabezpieczony przed zapisem.", vbExclamation + vbOKOnly
End Sub

Public Function KropkaWKwocie(ByVal kwota As String) As String
  Dim pozycjaPrzecinka As Long
  
  Mid(kwota, Len(kwota) - 2, 1) = "."
  KropkaWKwocie = kwota
End Function

Z góry dziękuję za pomoc.
Ostatnio zmieniony pn paź 21, 2013 2:08 pm przez piotrdw, łącznie zmieniany 1 raz.
Kubuntu 11.10 LibreOffice 4.1
Jan_J
Posty: 4557
Rejestracja: pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Przekonwertowanie makra VBA na Libreoffice

Post autor: Jan_J »

Nie rozumie metody Application.GetSaveAsFilename. Błąd 423: Property or method not found.
Jeżeli działało w poprzednich wydaniach a nie działa teraz, podejrzewam błąd w Libre.
Jeżeli nie zależy Ci na zgodności z Excelem, możesz zastąpić tę linijkę podobnym dialogiem LibreOffice'a.
// Nie znam się na VBA w Libre, nie wiem czy ta metoda była i zniknęła, czy nigdy nie została zaimplementowana tak jak w Excelu. Wiem, że Option VBASupport generuje dziwne skutki i wolę jej nie tykać.

//edit
1. W Apache OO 4.0.1 też nie mogę użyć tej metody, nawet w najprostszym wywołaniu bez parametrów
2. \seealso http://forum.openoffice.org/en/forum/vi ... =20&t=8020
JJ
LO (7.6) ∙ AOO (4.1) ∙ Python (3.11|3.10) ∙ Unicode 15 ∙ LᴬTEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Rocky|CentOS)
belstar
Posty: 654
Rejestracja: czw mar 17, 2011 9:08 am

Re: Przekonwertowanie makra VBA na Libreoffice

Post autor: belstar »

Jeżeli nie zależy ci na działaniu w excelu, mogę pobawić się w konwersje, ale będę potrzebował przykładowy plik, który ma być zapisany jako CSV do testów
LibreOffice 5.1.2.2 Ubuntu 16 LTS
piotrdw
Posty: 4
Rejestracja: śr paź 09, 2013 9:48 am

Re: Przekonwertowanie makra VBA na Libreoffice

Post autor: piotrdw »

Na excelu mi nie zależy, właśnie dlatego się z tym męczę żeby się pozbyć obciążenia Microsoftu. Jutro jak będę w robocie to podeślę przykładowy plik na PW albo na email. Dzięki za dobre chęci.
Kubuntu 11.10 LibreOffice 4.1
piotrdw
Posty: 4
Rejestracja: śr paź 09, 2013 9:48 am

Re: Przekonwertowanie makra VBA na Libreoffice

Post autor: piotrdw »

Dziękuję za pomoc plik działa jak należy i wszystko gra. Sam bym sobie z tym nie poradził. Teraz jak się przyglądam działaniu programu to faktycznie takie rozbudowane pętle są zbędne. Oczywiście uwagi przekażę informatykom, ale z góry wiadomo jak to się skończy. W każdym bądź razie jeszcze raz wielkie dzięki bo bardzo ułatwi mi to pracę. Należy się wielkie piwo.
Kubuntu 11.10 LibreOffice 4.1
belstar
Posty: 654
Rejestracja: czw mar 17, 2011 9:08 am

Re: [SOLVED] Przekonwertowanie makra VBA na Libreoffice

Post autor: belstar »

Uważam że powinieneś wstawić kod dostosowany do działania w OO, pomoże to innym, którzy staną przed podobnym problemem.
LibreOffice 5.1.2.2 Ubuntu 16 LTS
piotrdw
Posty: 4
Rejestracja: śr paź 09, 2013 9:48 am

Re: [SOLVED] Przekonwertowanie makra VBA na Libreoffice

Post autor: piotrdw »

belstar pisze:Uważam że powinieneś wstawić kod dostosowany do działania w OO, pomoże to innym, którzy staną przed podobnym problemem.
Słuszna uwaga. Zaznaczam że autorem wszelkich poprawek jest belstar.

Kod: Zaznacz cały

    Rem Attribute VBA_ModuleType=VBAModule
    'Option VBASupport 1
    Option Explicit
    Const SEPARATOR_POL As String = ","
    Const SEPARATOR_NAZ As String = "_"
    Const FORMAT_DATY As String = "YYYYMMDD"
    Const FORMAT_CZASU As String = "HHMMSS"
    Const FORMAT_KWOTY As String = "0.00"


    Public Sub ZapiszDaneJakoCSV()
    On Local Error GoTo ZapiszDaneJakoCSV_ErrH

	Dim mess As String
	Dim nazwaPliku As String
	Dim np As Long
	Dim r As Long, i As Long
	Dim linia As String, wartoscJakoString As String
	Dim sk As Long
      
	Dim TC As Object
	Dim SH As Object
	
	TC = ThisComponent 
	SH = TC.Sheets.getByName("Uniqa-TTEl")
     
      'If ActiveWorkbook.ActiveSheet.Range("B2").Value = "" Then mess = mess & vbCrLf & " - brak numeru agenta"
      If SH.getCellRangeByName("B2").String = "" Then mess = mess & chr(13) & " - brak numeru agenta"
      'If ActiveWorkbook.ActiveSheet.Range("C2").Value = "" Then mess = mess & vbCrLf & " - brak kwoty wpłaty zbiorczej"
      If SH.getCellRangeByName("C2").String = "" Then mess = mess & chr(13) & " - brak kwoty wpłaty zbiorczej"
      'If ActiveWorkbook.ActiveSheet.Range("D2").Value = "" Then mess = mess & vbCrLf & " - brak daty dokonania wpłaty zbiorczej"
      If SH.getCellRangeByName("D2").String = "" Then mess = mess & chr(13) & " - brak daty dokonania wpłaty zbiorczej"
      'If ActiveWorkbook.ActiveSheet.Range("G12").Value <> "" Then mess = mess & vbCrLf & " - niespełniony warunek zgodności kwoty zbiorczej z sumą kwot transakcji!"
      If SH.getCellRangeByName("G12").String <> "" Then mess = mess & chr(13) & " - niespełniony warunek zgodności kwoty zbiorczej z sumą kwot transakcji!"



      For r = 4 To 1000
    
        If ((SH.getCellByPosition(0, r - 1).getString <> "") _
        Or (SH.getCellByPosition(1, r - 1).getString <> "") _
        Or (SH.getCellByPosition(2, r - 1).getString <> "") _
        Or (SH.getCellByPosition(3, r - 1).getString <> "")) _
        And Not ((SH.getCellByPosition(0, r - 1).getString <> "") _
        And (SH.getCellByPosition(1, r - 1).getString <> "") _
        And (SH.getCellByPosition(2, r - 1).getString <> "") _
        And (SH.getCellByPosition(3, r - 1).getString <> "")) _
        Then mess = mess & Chr(13) & " - niekompletne dane w wierszu " & CStr(r)
  	
        'If ((ActiveWorkbook.ActiveSheet.Cells(r, 1) <> "") _
        'Or (ActiveWorkbook.ActiveSheet.Cells(r, 2) <> "") _
        'Or (ActiveWorkbook.ActiveSheet.Cells(r, 3) <> "") _
        'Or (ActiveWorkbook.ActiveSheet.Cells(r, 4) <> "")) _
        'And Not ((ActiveWorkbook.ActiveSheet.Cells(r, 1) <> "") _
        'And (ActiveWorkbook.ActiveSheet.Cells(r, 2) <> "") _
        'And (ActiveWorkbook.ActiveSheet.Cells(r, 3) <> "") _
        'And (ActiveWorkbook.Act1iveSheet.Cells(r, 4) <> "")) _
        'Then mess = mess & vbCrLf & " - niekompletne dane w wierszu " & CStr(r)
      Next r
     
     
      If mess <> "" Then
        MsgBox "Przed zapisaniem pliku proszę poprawić następujące błędy:" & chr(13) & mess, 1 + 48, "Błąd"
        Exit Sub
      End If   
	'nazwaPliku = Application.GetSaveAsFilename(ActiveWorkbook.ActiveSheet.Cells(2, 2) _
	nazwaPliku = SH.getCellByPosition(1, 1).getString _
	& SEPARATOR_NAZ _
	& Format(SH.getCellByPosition(3, 1).getValue, FORMAT_DATY) _
	& SEPARATOR_NAZ _
	&(SH.getCellByPosition(18, 1).getString) _
	& "PLN" _
	& SEPARATOR_NAZ _
	& Format(Date(), FORMAT_DATY) _
	& SEPARATOR_NAZ _
	& Format(Time(), FORMAT_CZASU) _
	& ".csv"
       '& SEPARATOR_NAZ & Format(ActiveWorkbook.ActiveSheet.Cells(2, 4), _
       '_
   '    & SEPARATOR_NAZ & (ActiveWorkbook.ActiveSheet.Cells(2, 19)) & _
   		' _
   	'	 _
    '   "PLN" & SEPARATOR_NAZ & Format(Date, FORMAT_DATY) & SEPARATOR_NAZ & Format(Time(), FORMAT_CZASU), _
    
     '  "Pliki z wartościami rozdzielanymi przecinkami (*.csv), *.csv", 0, "Wskaż gdzie i pod jaką nazwą zapisać plik")
   
  'test =  Format$(SH.getCellByPosition(3, 1).getValue, FORMAT_DATY)
   
   
     
    OOoFolderOpenDialog(nazwaPliku, "Wskaż gdzie zapisać plik")
   
     
    	np = FreeFile
     
      Open nazwaPliku For Output As np
     
       
      Print #np, SH.getCellByPosition(0, 1).getString _
      & SEPARATOR_POL & SH.getCellByPosition(1, 1).getString _
      & SEPARATOR_POL & KropkaWKwocie(Format$(SH.getCellByPosition(2, 1).getValue, FORMAT_KWOTY)) _
      & SEPARATOR_POL & Format$(SH.getCellByPosition(3, 1).getValue, FORMAT_DATY)
      
      'Print #np, ActiveWorkbook.ActiveSheet.Cells(2, 1) _
      '& SEPARATOR_POL & ActiveWorkbook.ActiveSheet.Cells(2, 2) _
      '& SEPARATOR_POL & KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(2, 3), FORMAT_KWOTY)) _
      '& SEPARATOR_POL & Format$(ActiveWorkbook.ActiveSheet.Cells(2, 4), FORMAT_DATY)
         
      sk = 13
     
      wartoscJakoString = SH.getCellByPosition(0, 1).getString
      'wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(2, 1))
      
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i

      wartoscJakoString = SH.getCellByPosition(1, 1).getString
      'wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(2, 2))
      
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i

      wartoscJakoString = KropkaWKwocie(Format$(SH.getCellByPosition(2, 1).getValue, FORMAT_KWOTY))
      'wartoscJakoString = KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(2, 3), FORMAT_KWOTY))
      
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i
     
      wartoscJakoString = Format$(SH.getCellByPosition(3, 1).getValue, FORMAT_DATY)
      'wartoscJakoString = Format$(ActiveWorkbook.ActiveSheet.Cells(2, 4), FORMAT_DATY)      
      
      For i = 1 To Len(wartoscJakoString)
        sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
      Next i
     
     
     
      For r = 3 To 999
      
        If SH.getCellByPosition(0, r).getString _
        & SEPARATOR_POL _
        & SH.getCellByPosition(1, r).getString _
        & SEPARATOR_POL _
        & SH.getCellByPosition(2, r).getString _
        & SEPARATOR_POL _
        & SH.getCellByPosition(3, r).getString _
        <> SEPARATOR_POL _
        & SEPARATOR_POL _
        & SEPARATOR_POL Then
          linia = SH.getCellByPosition(0, r).getString _
          & SEPARATOR_POL _
          & SH.getCellByPosition(1, r).getString _
          & SEPARATOR_POL _
          & KropkaWKwocie(Format$(SH.getCellByPosition(2, r).getValue, FORMAT_KWOTY)) _
          & SEPARATOR_POL _
          & Format$(SH.getCellByPosition(3, r).getValue, FORMAT_DATY)
          
          'If ActiveWorkbook.ActiveSheet.Cells(r, 1) _
        '& SEPARATOR_POL _
        '& ActiveWorkbook.ActiveSheet.Cells(r, 2) _
        '& SEPARATOR_POL _
        '& ActiveWorkbook.ActiveSheet.Cells(r, 3) _
        '& SEPARATOR_POL _
        '& ActiveWorkbook.ActiveSheet.Cells(r, 4) _
       ' <> SEPARATOR_POL _
        '& SEPARATOR_POL _
       ' & SEPARATOR_POL Then
          'linia = ActiveWorkbook.ActiveSheet.Cells(r, 1) _
          '& SEPARATOR_POL _
          '& ActiveWorkbook.ActiveSheet.Cells(r, 2) _
          '& SEPARATOR_POL _
          '& KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(r, 3), FORMAT_KWOTY)) _
          '& SEPARATOR_POL _
          '& Format$(ActiveWorkbook.ActiveSheet.Cells(r, 4), FORMAT_DATY)
          
          Print #np, linia
       
          wartoscJakoString = SH.getCellByPosition(0, r).getString
          'wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(r, 1))
          
          For i = 1 To Len(wartoscJakoString)
            sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
          Next i
       
          wartoscJakoString = SH.getCellByPosition(1, r).getString
          'wartoscJakoString = CStr(ActiveWorkbook.ActiveSheet.Cells(r, 2))          
          
          For i = 1 To Len(wartoscJakoString)
            sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
          Next i
       
          wartoscJakoString = KropkaWKwocie(Format$(SH.getCellByPosition(2, r).getValue, FORMAT_KWOTY))
          'wartoscJakoString = KropkaWKwocie(Format$(ActiveWorkbook.ActiveSheet.Cells(r, 3), FORMAT_KWOTY))          
          
          For i = 1 To Len(wartoscJakoString)
            sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
          Next i
         
          wartoscJakoString = Format$(SH.getCellByPosition(3, r).getValue, FORMAT_DATY)
          'wartoscJakoString = Format$(ActiveWorkbook.ActiveSheet.Cells(r, 4), FORMAT_DATY)          
          
          For i = 1 To Len(wartoscJakoString)
            sk = sk + Asc(Mid$(wartoscJakoString, i, 1))
          Next i
       
        End If
      Next r
     

      Print #np, CStr(sk)
     
      Close np
     
      'ActiveWorkbook.Saved = True
      TC.Store(True)
      
     	
      MsgBox "Dziękujemy, dane zostały pomyślnie zapisane do pliku " _
      & nazwaPliku _
      & Chr(13) & "Prosimy o przesłanie tego pliku do Banku według uzgodnionej procedury.", _
      64
    Exit Sub

ZapiszDaneJakoCSV_ErrH:
      Close
      MsgBox "Zapis danych do pliku " & nazwaPliku & " nie powiódł się!" & Chr(13) & _
      "Proszę sprawdzić czy na dysku jest wystarczająca ilość wolnego miejsca oraz czy nie jest zabezpieczony przed zapisem.", _
      48
    End Sub

    Public Function KropkaWKwocie(ByVal kwota As String) As String
      Dim pozycjaPrzecinka As Long
     
      Mid(kwota, Len(kwota) - 2, 1) = "."
      KropkaWKwocie = kwota
    End Function


	function OOoFolderOpenDialog(fname, title) as string
			Dim picker as object
			
            ' definiuje okno dialogowe wyboru folderu via OOo '
            picker = CreateUnoService( "com.sun.star.ui.dialogs.FolderPicker" )
            'picker.setDisplayDirectory(ConvertToURL( "/" ) & fname)
            picker.setTitle(title)
            if picker.execute() then
                fname = picker.getDirectory() & "/" & fname
            else
                fname = ""
            endif
            OOoFolderOpenDialog = fname
    end function

Kubuntu 11.10 LibreOffice 4.1
PavulonK
Posty: 1
Rejestracja: pn cze 11, 2018 9:46 pm

Re: [SOLVED] Przekonwertowanie makra VBA na Libreoffice

Post autor: PavulonK »

Witam.
mam problem z makro z excel-a. Wczytuje plik w LibreOffice i jest ok do momentu zapisu pliku czy xlms czy ods. Otworzony taki plik nie działa z makro.
Czy ktos może pomóc w konwersji VBA na Basic? Kod poniżej:

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("BX10:CV341, CX:DW, DY:EX, EZ:FV, FX:GX, GZ:HX, HZ:IV"))
If Target Is Nothing Then Exit Sub
If Target.Count > 1 Or IsError(Target) Then Exit Sub
If Target = "" Then Exit Sub
Application.EnableEvents = False
Target.Value = Application.VLookup(Target, Range("AL348:AM361"), 2, False)
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'updateby Extendoffice 20160530
On Error GoTo LZoom
Dim xZoom As Long
xZoom = 60
If Target.Validation.Type = xlValidateList Then xZoom = 130
LZoom:
ActiveWindow.Zoom = xZoom
End Sub

Z góry dziękuje za pomoc.
LibreOffice 6.04 na Windows 7
ODPOWIEDZ