[SOLVED] Przekonwertowanie makra VBA na Libreoffice

Makropolecenia i funkcje w języku Basic

[SOLVED] Przekonwertowanie makra VBA na Libreoffice

Postprzez piotrdw » Śr paź 09, 2013 10:05 am

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   Rozszerz widokZwiń widok
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 edytowano Pn paź 21, 2013 2:08 pm przez piotrdw, łącznie edytowano 1 raz
Kubuntu 11.10 LibreOffice 4.1
piotrdw
 
Posty: 4
Dołączył(a): Śr paź 09, 2013 9:48 am

Re: Przekonwertowanie makra VBA na Libreoffice

Postprzez Jan_J » Śr paź 09, 2013 5:36 pm

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 5.4 ∙ AOO 4.1.4 ∙ Python (3.6|2.7) ∙ Unicode 10 ∙ LATEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Fedora|CentOS|SUSE)
Jan_J
 
Posty: 3625
Dołączył(a): Pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Przekonwertowanie makra VBA na Libreoffice

Postprzez belstar » Cz paź 10, 2013 8:58 am

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
belstar
 
Posty: 635
Dołączył(a): Cz mar 17, 2011 9:08 am

Re: Przekonwertowanie makra VBA na Libreoffice

Postprzez piotrdw » Cz paź 10, 2013 10:41 pm

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
Dołączył(a): Śr paź 09, 2013 9:48 am

Re: Przekonwertowanie makra VBA na Libreoffice

Postprzez piotrdw » Pn paź 21, 2013 2:07 pm

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
piotrdw
 
Posty: 4
Dołączył(a): Śr paź 09, 2013 9:48 am

Re: [SOLVED] Przekonwertowanie makra VBA na Libreoffice

Postprzez belstar » Pn paź 21, 2013 4:57 pm

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
belstar
 
Posty: 635
Dołączył(a): Cz mar 17, 2011 9:08 am

Re: [SOLVED] Przekonwertowanie makra VBA na Libreoffice

Postprzez piotrdw » Wt paź 22, 2013 11:15 am

belstar napisał(a):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   Rozszerz widokZwiń widok
    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
piotrdw
 
Posty: 4
Dołączył(a): Śr paź 09, 2013 9:48 am

Re: [SOLVED] Przekonwertowanie makra VBA na Libreoffice

Postprzez PavulonK » Pn cze 11, 2018 9:52 pm

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
PavulonK
 
Posty: 1
Dołączył(a): Pn cze 11, 2018 9:46 pm


Powrót do Basic

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników i 1 gość