Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 21. 10. 2009 15:45:51

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Zlúčenie zošitov - Makro

Prosím Vás o pomoc ako pomocou makra zlúčiť niekoľko otvorených zošitov (všetky listy) do nového. Všetky moje pokusy zlyhali. Pomôžu mi aj čiastočné riešenia

Editoval P07 (21. 10. 2009 15:48:40)

Offline

#2 26. 10. 2009 18:10:54

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

 Sub Main
    firstDoc = ThisComponent
    selectSheetByName(firstDoc, "Sheet2")
    dispatchURL(firstDoc,".uno:SelectAll")
    dispatchURL(firstDoc,".uno:Copy")
    secondDoc = StarDesktop.loadComponentFromUrl("private:factory/scalc","_blank",0,dimArray())
    secondDoc.getSheets().insertNewByName("inserted",0)
    selectSheetByName(secondDoc, "inserted")
    dispatchURL(secondDoc,".uno:Paste")
End Sub

sub selectSheetByName(document, sheetName)
    document.getCurrentController.select(document.getSheets().getByName(sheetName))
end sub

Sub dispatchURL(document, aURL)
    Dim noProps()
    Dim URL as new com.sun.star.util.URL
    frame = document.getCurrentController().getFrame()
    URL.Complete = aURL
    transf = createUnoService("com.sun.star.util.URLTransformer")
    transf.parseStrict(URL)
    disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
    disp.dispatch(URL, noProps())
End Sub

Offline

#3 17. 11. 2009 02:12:05

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

No vidím že ste "vykuchal" AndrewMacro.
Nemám kompletné riešenie, len čiastočné možno to niekto dotiahne, kým sa k tomu opäť dostanem (lebo už zaspávam) smile

sub uloz_listy
uloz_listy_do_jedneho_zositu("/home/miro/dokumenty/test.ods")'tu zmeň cestu k tvojmu novému zošitu do ktorého sa skopírujú listy
end sub

sub uloz_listy_do_jedneho_zositu(optional cesta as string)
dim oDoc, eDocs,oSheet,oNovy_list ,oDoc_novy,oZosit  as object, i,list as integer, sURL,sCesta,nazov as string
list=0
 sURL = "private:factory/scalc"
  set oDoc_novy = StarDesktop.loadComponentFromURL(sURL, " ", 0, Array())'vytvor novy zosit
uloz_ako(cesta)
set eDocs = StarDesktop.Components.CreateEnumeration' vytvor kolekciu otvorenych dokumentov
  on error goto DALSI
  do while eDocs.hasMoreElements ' prejdi kolekciu dokumentov
    set oDoc = eDocs.NextElement 
     if oDoc.ImplementationName="ScModelObj" then ' pokiaľ je to zošit
         if (ConvertFromURL(oDoc.URL))=cesta then ' a tento zošit to nemôže byť, lebo do toho kopírujeme
         
         else 'nie je to zošit do ktorého sa kopíruje 
         msgbox oDoc.URL 'cesta niektorého otvoreného zošitu za týmto vložiť podmienku pokiaľ by bol otvorený zošit ešte neuložený zobrazí cestu prázdnu
    
    oDoc.CurrentController.Frame.activate  
    nastav_subor(oDoc.CurrentController.Frame.Title)
    current= oDoc.CurrentController.Frame.Title

'tak a teraz prejdi listy
  with  ThisComponent.Sheets
    for i = 0 to .Count -1
      set oSheet = .GetByIndex(i)
meno=oSheet.Name
print meno
vyber(meno)
'zkopiruj
'gosub vloz_do_testu
next i
end with
end if       
end if
DALSI:
  loop
uloz_zosit("/home/miro/dokumenty/test.ods")
exit sub

vloz_do_testu:
ovladanie.nastav_subor("test")
vyberlb(list,"A1")
vloz
list=list+1
ovladanie.nastav_subor(current)
return
 end sub

sub zkopiruj
dim oDoc,oDisp as object
oDoc= ThisComponent.CurrentController.Frame
oDisp=createUnoService("com.sun.star.frame.DispatchHelper")
oDisp.executeDispatch(oDoc, ".uno:Copy", "", 0, Array())'zkopírovanie dát do schránky
'msgbox("zkopírované",0,"Oznam")
end sub

sub vyber(optional list as string)
dim oSheet,oCell as object, bunka as string
oSheet= ThisComponent.Sheets.getByname(list)
oCell = oSheet.getCellRangeByName("A1:AMJ65536")
ThisComponent.getCurrentController.select(oCell)
end sub

sub vyberlb(optional list as string,optional bunka as string)
dim oSheet,oCell as object
oSheet= ThisComponent.Sheets.getByIndex(list)
oCell = oSheet.getCellRangeByName(bunka)
ThisComponent.getCurrentController.select(oCell)
end sub

sub vloz 'číslo,formát,text,dátum
dim dispatcher,document as object
dim vloz(5) as new com.sun.star.beans.PropertyValue
vloz(0).Name = "Flags"
vloz(0).Value = "SVDT"
vloz(1).Name = "FormulaCommand"
vloz(1).Value = 0
vloz(2).Name = "SkipEmptyCells"
vloz(2).Value = false
vloz(3).Name = "Transpose"
vloz(3).Value = false
vloz(4).Name = "AsLink"
vloz(4).Value = false
vloz(5).Name = "MoveMode"
vloz(5).Value = 4
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
set document= ThisComponent.CurrentController.Frame
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, vloz())'vloženie dát ako čísiel zo schránky
'msgbox("vložené",0,"Oznam")
end sub

sub nastav_subor(optional nazov as string)'nastaví hladaný otvorený zošit
dim oDesk, oFrames, oFrame,oDoc,oActivny as object, sURL,nazov1 as string,i as integer
  set oDesk = StarDesktop
  set oFrames = oDesk.Frames
  for i=0 to oFrames.Count - 1
  set oFrame = oFrames.getByIndex(i)
     nazov1=oFrame.Title
    if nazov1=nazov then    
     oFrame.activate 
     oActivny=oFrame.ComponentWindow
     oActivny.setFocus   
    ' msgbox "pravda"
    else
   ' msgbox "nepravda"
 ' msgbox oFrame.Title 
    end if
  next i
end sub

sub uloz_zosit(optional cesta as string)
dim oDoc, eDocs as object
  set eDocs = StarDesktop.Components.CreateEnumeration' vytvor kolekciu otvorenych dokumentov
  on error goto DALSI
  do while eDocs.hasMoreElements ' prejdi kolekciu dokumentov
    set oDoc = eDocs.NextElement 
     if oDoc.ImplementationName="ScModelObj" then ' pokiaľ je to zošit   
      if(ConvertFromURL(oDoc.URL))=cesta then ' a je to hladany zošit
        oDoc.Store() ' tak ho uloz
        oDoc.Close(true) ' a zavri
        exit sub '  končíme
      end if
    end if
DALSI:
  loop
end sub

sub uloz_ako (optional cesta as string)'ak dokument zmením ale chcem ho uložiť pod iným menom
dim oDoc as object
on error goto chyba
  oDoc=ThisComponent
  with oDoc    
        .storeAsURL(ConvertToURL(cesta), Array()) ' ulozit ako
  end with
  exit sub
chyba:
  msgbox("chyba!!!",0,"Chyba uloz_ako")
stop
end sub

Snáď vám to pomôže makro mi však zastane pri druhom zošite na prvom liste - treba sa s tým pohrať.
Makro najskôr otvorí nový zošit, potom ho uloží ako test.ods. Ďalej začne prechádzať otvorené zošity a pri prvom nájdenom začne prechádzať jeho listy a kopírovať ich pomocou schránky do listov v zošite Test.ods. (tu je potrebné dorobiť vloženie ďalších listov do tohoto súboru - toľko koľko bude potrebné na kopírovanie, takže ak sa skopírovalo na posledný list vložiť ďalší čistý).Ďalej je potrebné doladiť makro, resp nájsť chybu prečo zostane na druhom zošite.
Na koniec makro uloží dokument Test.ods.
No snáď to pomôže, ak budem mať viac času tak sa stým ešte pohrám.:)

Editoval mirozm (17. 11. 2009 02:39:02)


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

#4 17. 11. 2009 10:39:01

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

Ďakujem za ochotu ale to makro som už dávno dotiahol do konca. AndrewMacro ako aj ďalšie som použil ako štartovací mostík, ten kód som sem skopíroval aby sa mali od čoho odraziť ostatní. Dorobený kód som sem nedal lebo si myslím, že je lepšie ukázať vo fóre len cestu na ktorej sa niečo naučí ako dať mu rovno výsledok. Ďalším dôvodom prečo som to tu viac nerozoberal bolo to, že toto fórum považujem z hľadiska makier za mŕtve. Viac krát som sem písal otázky ale odpovedi som sa nedočkal tak mi to pripadalo zbytočné. Ak poznáte fórum kde sa o Makrách v OOo diskutuje aktívnejšie (CZ/SK) prosím Vás dajte mi vedieť.

Ešte raz dík...

Offline

#5 17. 11. 2009 17:18:08

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

Žiaľ áno, je to pravda, že na zložitejšie problémy ohľadom makier je tu dosť málo odpovedí.
A pokiaľ sa pamätám bolo to tak aj predtým (hoci som to tu navštevoval, len sporadicky).
Makrám sa venuje menej ľudí a myslím, že to tu skôr navštevujú bežný užívatelia. (no a ešte začínajúci, ktorý potrebujú nájsť jednoduchšie veci)
PS:Zaujímalo by ma, ako ste to vyriešil Vy. Ak by som neobťažoval, mohol by ste mi poslať kód na e-mail?
Ďakujem


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

#6 17. 11. 2009 21:22:55

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

Na úvod by som rád navrhol tykanie. Dúfam, že to nebude problém.
Ak si dobre pamätám tak som to spravil tak, že sa nezlúčia otvorené ale tie ktoré sa označia na zlúčenie v okne Otvoriť... Nieje to úplne blbuvzdorné čo znamená, že sa dá ľahko vyvolať chyba alebo zlyhanie ale zatiaľ sa baby nesťažovali.
Mám trocha nečisté svedomie, že to makro nerozlišuje či vkladá prázdne strany ale ako som už písal zatiaľ je ticho tak aj ja mlčím. Nenapadá ma ako zistiť či je v liste niečo napísané alebo nie. Overiť všetky bunky na ISBLANK je nepoužiteľné. Ak poznáš nejaké elegantné a hlavne rýchle riešenie tak daj vedieť.

Sub Zlucit_Subory
'**************************Načťítanie súborov ktoré sa majú zlúčiť************************
   Dim oFileDialog as Object
   Dim iAccept as Integer
   Dim sPath() as String
   Dim InitPath as String
   Dim RefControlName as String
   Dim oUcb as Object
   'Dim ListAny(0)
   Dim filterNames(1) As String
   Dim MultiSelection As Boolean
   
   filterNames(0) = "*.ods; *.xls"
   filterNames(1) = "*.*"
   MultiSelection = True
   
    'knižnica ktorá medzi iným umožnuje načítať pracovný adresár
   GlobalScope.BasicLibraries.LoadLibrary("Tools")
   'Note: The following services must be called in the following order ' otherwise the FileDialog Service is not removed.
   oFileDialog =CreateUnoService("com.sun.star.ui.dialogs.FilePicker") 
   oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") 'ListAny(0) = _
   ' com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
   'oFileDialog.initialize(ListAny())

   'umožní alebo zakáže viacnásobné označovanie súborov
   oFileDialog.MultiSelectionMode=MultiSelection

   'pridáva filter ktoré súbory sa majú zobraziť podla FilterNames
   AddFiltersToDialog(FilterNames(), oFileDialog)
   
    'Názov okna
   oFileDialog.Title="Vyberte súbory na zlúčenie"
   'Set your initial path here!
   'InitPath = ConvertToUrl(oRefModel.Text)
    Do 
       If InitPath = "" Then
         InitPath = GetPathSettings("Work")
       End If
       If oUcb.Exists(InitPath) Then
         oFileDialog.SetDisplayDirectory(InitPath)
       End If
       iAccept = oFileDialog.Execute()
       If iAccept = 1 Then
         sPath = oFileDialog.Files()
         
         'If oUcb.Exists(sPath) Then
         '  oRefModel.Text = ConvertFromUrl(sPath)
         'End If
       End If
       'Ak bol vybraný jeden súbor tak nieje čo zlučovať
       If UBound(sPath)<=0  Then 
               sVar% =MsgBox("Chceš vybrať znova?",148,"Bol zvolený len jeden súbor")
               if sVar<>6 Then exit sub
       end if 

   Loop While UBound(sPath)<=0 
   
   oFileDialog.Dispose()
   
   '*********************************Otváranie dokumentov*********************
'Long - &
'String - $
'Integer - %

   Dim ZpusobOtevreni1(1) As new com.sun.star.beans.PropertyValue
   Dim ZpusobOtevreni2(0) As new com.sun.star.beans.PropertyValue
    Dim Dokument, NovyDokument As Object
    Dim Adresa, List As String
   'otvorenie nového súboru
      ZpusobOtevreni2(0).Name = "DocumentTitle"
      ZpusobOtevreni2(0).Value = "Zlucene_dokumenty"
      NovyDokument= StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, ZpusobOtevreni2())
         
   clNovy&=0
           
   for SuborIndex&=1 to UBound(sPath)
      Adresa=sPath(0)&"/"&sPath(SuborIndex)
      If oUcb.Exists(Adresa) Then
          ZpusobOtevreni1(0).Name = "ReadOnly"
          ZpusobOtevreni1(0).Value = True
          ZpusobOtevreni1(1).Name = "Hidden"
          ZpusobOtevreni1(1).Value = True
          Dokument=StarDesktop.loadComponentFromURL(Adresa,"_blank", 0, ZpusobOtevreni1())

          for clDokument&=0 to Dokument.getSheets.getCount-1
              'list
            List=Dokument.Sheets.getByIndex(clDokument).Name
            
            'zistí či nový súbor má volný list ak nie  tak ho vytvorí
            If NovyDokument.getSheets.getCount-1<clNovy Then NovyDokument.getSheets().insertNewByName("Nový list",clNovy)
            
            'vyber list ktorý chceš kopírovať
            selectSheetByName(Dokument, List)
            'označí všetko
            dispatchURL(Dokument,".uno:SelectAll")
            'kopíruje
            dispatchURL(Dokument,".uno:Copy")
            'vyber list kam chceš kopírovať
            selectSheetByName(NovyDokument, NovyDokument.Sheets.getByIndex(clNovy).Name)
            'vloží
            dispatchURL(NovyDokument,".uno:Paste")

            'premenovanie listu podla názvu súboru a názvu listu
            MenoListu=Replace(sPath(SuborIndex)&" "&List, "%20", " ")
            NovyDokument.Sheets.getByIndex(clNovy).setName(MenoListu)
            clNovy=clNovy+1
          next clDokument
          
          Dokument.Dispose()
      End if
      
    Next SuborIndex

   
 End Sub
 



sub selectSheetByName(document, sheetName)
    document.getCurrentController.select(document.getSheets().getByName(sheetName))
end sub

Sub dispatchURL(document, aURL)
    Dim noProps()
    Dim URL as new com.sun.star.util.URL
    frame = document.getCurrentController().getFrame()
    URL.Complete = aURL
    transf = createUnoService("com.sun.star.util.URLTransformer")
    transf.parseStrict(URL)
    disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
    disp.dispatch(URL, noProps())
End Sub

Editoval P07 (19. 11. 2009 10:13:15)

Offline

#7 17. 11. 2009 22:57:26

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 769

Re: Zlúčenie zošitov - Makro

P07 napsal(a)

Mám trocha nečisté svedomie, že to makro nerozlišuje či vkladá prázdne strany ale ako som už písal zatiaľ je ticho tak aj ja mlčím. Nenapadá ma ako zistiť či je v liste niečo napísané alebo nie.

Zkuste využít funkce listu (třeba count).

Editoval lp. (18. 11. 2009 00:55:36)

Offline

#8 19. 11. 2009 10:09:36

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

S tikaním nie je problém, pokiaľ to nie je niekde v kufríku na hlavnej stanici. smile smile smile
Pekné, páči sa mi hlavne ten spôsob otvorenia ( že to "nepláca" na plochu).
No Ty kopíruješ listy z už uložených dokumentov. Ja som myslel a začal riešiť otvorené dokumenty a to aj pokiaľ neboli ešte uložené.
Ďakujem, že si sem hodil ten kód, je dobré vidieť aj, ako to riešia iný.
Miro


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

#9 19. 11. 2009 15:59:01

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

Miro máš pravdu trocha som sa od pôvodného zadania odklonil ale takto sa mi to zdá praktickejšie.
Tak a tu je už upravený kód ktorý rozlišuje či sa na strane niečo nachádza alebo nie plus sú tam aj kozmetické úpravy.

Sub Zlucit_Subory
'**************************Načťítanie súborov ktoré sa majú zlúčiť************************
   Dim oFileDialog as Object
   Dim iAccept as Integer
   Dim sPath() as String
   Dim InitPath as String
   Dim RefControlName as String
   Dim oUcb as Object
   'Dim ListAny(0)
   Dim filterNames(1) As String
   Dim MultiSelection As Boolean
   
   filterNames(0) = "*.ods; *.xls"
   filterNames(1) = "*.*"
   MultiSelection = True
   
    'knižnica ktorá medzi iným umožnuje načítať pracovný adresár
   GlobalScope.BasicLibraries.LoadLibrary("Tools")
   'Note: The following services must be called in the following order ' otherwise the FileDialog Service is not removed.
   oFileDialog =CreateUnoService("com.sun.star.ui.dialogs.FilePicker") 
   oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") 'ListAny(0) = _
   ' com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
   'oFileDialog.initialize(ListAny())

   'umožní alebo zakáže viacnásobné označovanie súborov
   oFileDialog.MultiSelectionMode=MultiSelection

   'pridáva filter ktoré súbory sa majú zobraziť podla FilterNames
   AddFiltersToDialog(FilterNames(), oFileDialog)
   
    'Názov okna
   oFileDialog.Title="Vyberte súbory na zlúčenie"
   'Set your initial path here!
   'InitPath = ConvertToUrl(oRefModel.Text)
    Do 
       If InitPath = "" Then
         InitPath = GetPathSettings("Work")
       End If
       If oUcb.Exists(InitPath) Then
         oFileDialog.SetDisplayDirectory(InitPath)
       End If
       iAccept = oFileDialog.Execute()
       If iAccept = 1 Then
         sPath = oFileDialog.Files()
         
         'If oUcb.Exists(sPath) Then
         '  oRefModel.Text = ConvertFromUrl(sPath)
         'End If
       End If
       'Ak bol vybraný jeden súbor tak nieje čo zlučovať
       coto=UBound(sPath)
       If UBound(sPath)=0  Then 
               sVar% =MsgBox("Chceš vybrať znova?",148,"Bol zvolený len jeden súbor")
               if sVar<>6 Then Exit Sub
       'bolo stlačené tlačítko zrušiť
       elseif UBound(sPath)=-1 Then
               Exit Sub
       end if 

   Loop While UBound(sPath)<=0 
   
   oFileDialog.Dispose()
   
   '*********************************Otváranie dokumentov*********************
'Long - &
'String - $
'Integer - %

   Dim ZpusobOtevreni1(1) As new com.sun.star.beans.PropertyValue
   Dim ZpusobOtevreni2(0) As new com.sun.star.beans.PropertyValue
    Dim Dokument, NovyDokument As Object
    Dim Adresa, List As String
   'otvorenie nového súboru
      ZpusobOtevreni2(0).Name = "DocumentTitle"
      ZpusobOtevreni2(0).Value = "Zlucene_dokumenty"
      NovyDokument= StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, ZpusobOtevreni2())
         
   clNovy&=0
           
   for SuborIndex&=1 to UBound(sPath)
      Adresa=sPath(0)&"/"&sPath(SuborIndex)
      If oUcb.Exists(Adresa) Then
          ZpusobOtevreni1(0).Name = "ReadOnly"
          ZpusobOtevreni1(0).Value = True
          ZpusobOtevreni1(1).Name = "Hidden"
          ZpusobOtevreni1(1).Value = True
          Dokument=StarDesktop.loadComponentFromURL(Adresa,"_blank", 0, ZpusobOtevreni1())

          for clDokument&=0 to Dokument.getSheets.getCount-1
              'list
            List=Dokument.Sheets.getByIndex(clDokument).Name
        
            'vyber list ktorý chceš kopírovať
            selectSheetByName(Dokument, List)
            
            'skontroluje či na liste niečo je
            if PlnyList(Dokument, List) then
                'zistí či nový súbor má volný list ak nie  tak ho vytvorí
                If NovyDokument.getSheets.getCount-1<clNovy Then NovyDokument.getSheets().insertNewByName("Nový list",clNovy)
                
                'označí všetko
                dispatchURL(Dokument,".uno:SelectAll")
                'kopíruje
                            
                dispatchURL(Dokument,".uno:Copy")
                'vyber list kam chceš kopírovať
                selectSheetByName(NovyDokument, NovyDokument.Sheets.getByIndex(clNovy).Name)
                'vloží
                dispatchURL(NovyDokument,".uno:Paste")
    
                'premenovanie listu podla názvu súboru a názvu listu
                NovyDokument.Sheets.getByIndex(clNovy).setName(MenoListu(sPath(SuborIndex),List))
                clNovy=clNovy+1
            end if
            
          next clDokument
          
          Dokument.Dispose()
      End if
      
    Next SuborIndex

   
 End Sub
 

sub selectSheetByName(document, sheetName)
    document.getCurrentController.select(document.getSheets().getByName(sheetName))
end sub

Sub dispatchURL(document, aURL)
    Dim noProps()
    Dim URL as new com.sun.star.util.URL
    frame = document.getCurrentController().getFrame()
    URL.Complete = aURL
    transf = createUnoService("com.sun.star.util.URLTransformer")
    transf.parseStrict(URL)
    disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
    disp.dispatch(URL, noProps())
End Sub

Function PlnyList(document, sheetName) As Boolean
'zistí či aktývny list je prázdny
      'Dokument = ThisComponent
      'Stav = Dokument.getCurrentController
      List = document.getSheets().getByName(sheetName)
      Bunka = List.getCellbyPosition(0, 0)
      Kurzor = List.createCursorByRange(Bunka)
    'prejde na poslednú bunku využitej oblasti True-Vytvorí oblasť False-prejde len na bunku
      Kurzor.gotoEndOfUsedArea(False)
      Adresa = Kurzor.RangeAddress 

    if  Adresa.EndRow>0 or Adresa.EndColumn>0 or Bunka.Formula<>"" then
        PlnyList=True
    else        
        PlnyList=False
    end if
    
end Function


Function MenoListu (Subor, List as String) as String
'vytvorí sa názov nového listu podla názvu súboru a názvu listu
MenoListu=Subor & " " & List

'Niektoré písmenká to zopsuje takoto sa to napraví
Dim A As Variant, B As Variant
A = Array(" ","ă","ą","ć","č","ď","đ","ě","ę","ĺ","ľ","ł","ń","ň","ő","ŕ","ř","ś","ş","š","ť","ţ","ů","ű","ź","ž","ż","Ă","Ą","Ć","Č","Ď","Đ","Ě","Ę","Ĺ","Ľ","Ł","Ń","Ň","Ő","Ŕ","Ř","Ś","Ş","Š","Ť","Ţ","Ů","Ű","Ź")
B = Array("%20","%C4%83","%C4%85","%C4%87","%C4%8D","%C4%8F","%C4%91","%C4%9B","%C4%99","%C4%BA","%C4%BE","%C5%82","%C5%84","%C5%88","%C5%91","%C5%95","%C5%99","%C5%9B","%C5%9F","%C5%A1","%C5%A5","%C5%A3","%C5%AF","%C5%B1","%C5%BA","%C5%BE","%C5%BC","%C4%82","%C4%84","%C4%86","%C4%8C","%C4%8E","%C4%90","%C4%9A","%C4%98","%C4%B9","%C4%BD","%C5%81","%C5%83","%C5%87","%C5%90","%C5%94","%C5%98","%C5%9A","%C5%9E","%C5%A0","%C5%A4","%C5%A2","%C5%AE","%C5%B0","%C5%B9")

For i%=0 To UBound(A())
    MenoListu=Replace(MenoListu, B(i), A(i))
next i

end function

Miso

Editoval P07 (19. 11. 2009 15:59:56)

Offline

#10 19. 11. 2009 21:34:38

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

No pekné, ešte by som dal na záver nejaký
msgbox("Listy vami vybratých dokumentov boli zlúčené do nového dokumentu",0,"Zlúčenie listov")'hláška
Otázočka - nevieš ako msgbox zavrieť makrom za nejaký čas (napr. 5sec)?
Inak kopírujem Tvoje makro, ak by sa mi z neho v budúcnosti niečo hodilo.
Miro

Editoval mirozm (19. 11. 2009 21:34:59)


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

#11 19. 11. 2009 22:09:55

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

James napsal(a)

Otázočka - nevieš ako msgbox zavrieť makrom za nejaký čas (napr. 5sec)?

Veruže neviem.

Otázočka-ako docieliť aby sa makro spustilo po zadaní textu do bunky resp. ako priradiť makro ku konkrétnej bunke

Offline

#12 19. 11. 2009 22:15:35

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

NO myslím, že makro by muselo bežať od otvorenia dokumentu, kde by ako premenná bola práve sledovaná bunka a pokiaľ by sa jej obsah zmenil makro by zavolalo ďalšie makro , alebo func..
Bežiace makro by sa muselo stopnúť pri zatváraní dokumentu.
Asi tak. Myslím.


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

#13 19. 11. 2009 22:17:15

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

Mimochodom toto som už skúšal no nedopadlo to dobre.
Alebo priradiť makro k udalosti Dokument zmenený.

Edit: a veruže už viem. Vlož si tam nad bunku (prekry ju) prvkom formulára napr. textové pole a ten prepoj s tou bunkou, tak aby to čo vložíš do pola sa menilo aj v bunke a potom na karte udalosti daj po aktualizácii, alebo si vyber čo chceš a priraď k tomu to makro.

Editoval mirozm (19. 11. 2009 22:30:55)


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

#14 19. 11. 2009 23:44:03

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

Tak táto možnosť ma tiež napadla. Chcel som to ale nejako automatizovať z dôvodu veľa buniek

Offline

#15 20. 11. 2009 12:46:17

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

James napsal(a)

Otázočka - nevieš ako msgbox zavrieť makrom za nejaký čas (napr. 5sec)?

čo tak využiť dialógi? Napíš to ako novú tému a pošli mi odkaz. Keď mi trocha ubudne roboty tak sa na to pozriem. Ak ti medzi tým už niekto nenapíše odpoveď.

Offline

#16 23. 12. 2009 16:58:58

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

mirozm napsal(a)

No pekné, ešte by som dal na záver nejaký
msgbox("Listy vami vybratých dokumentov boli zlúčené do nového dokumentu",0,"Zlúčenie listov")'hláška
Otázočka - nevieš ako msgbox zavrieť makrom za nejaký čas (napr. 5sec)?

Miro

Tak tu je ten sľúbený kód na "msgbox" ktorý sa zavrie za určitý čas. Už si to len uprav na funkciu

Samozrejme že si musíš vytvoriť dialóg a hodiť naň po jednom tlačítko, label, progresbar.

Tlačítku do udalosti stlačenie myši priraď makro UkoncitDialogOK

Je tam malý neduh. Nevedel som ako zistiť či je dialóg zobrazený alebo nie tak som tam vložil ďalšiu globálnu premennú. Ak by niekto poznal elegantnejšie riešenie tak budem rád

   Global oDialog
   Global VisibleDialog as Boolean
   
Sub ZobrazitDialogOK
   Const nLabel="LabelText"
   Const nTlacitko="CommandButtonOK"
   Const nKnihovny = "Standard"
   Const nDialogu = "DialogOK"   
   Const nProgresBar="ProgressBar1"
      
   Const tLabel="Hotovo!"
   Const ProgressValueMin = 0
   Const ProgressValueMax = 12'čas v sekundách
   Const ProgressStep = 1
   Const tTlacito = "OK"

      
    KnihovniKontejner =  DialogLibraries
    KnihovniKontejner.LoadLibrary(nKnihovny, nDialogu)
    Knihovna = KnihovniKontejner.GetByName(nKnihovny)
    ModulPrvnihoDialogu = Knihovna.GetByName(nDialogu)

    'Definovanie jednotlivých objektov
    oDialog = CreateUnoDialog(ModulPrvnihoDialogu)
    oTlacitko = oDialog.getControl(nTlacitko)
    oText = oDialog.getControl(nLabel)
    oProgressBarModel = oDialog.getModel().getByName(nProgresBar)
    
    'Počitočné nastavenia
    oTlacitko.Label=tTlacito
    oText.Text = tLabel
    oProgressBarModel.setPropertyValue( "ProgressValueMin", ProgressValueMin)
    oProgressBarModel.setPropertyValue( "ProgressValueMax", ProgressValueMax)
    'Zobrazenie dialógu
    VisibleDialog=True
    oDialog.setVisible(True)
              
    For ProgressValue = ProgressValueMin To ProgressValueMax Step ProgressStep
If VisibleDialog=False then exit for
        oProgressBarModel.setPropertyValue( "ProgressValue", ProgressValue )
        Wait 1000
    Next ProgressValue
   End Sub

   Sub UkoncitDialogOK
   VisibleDialog=False
    oDialog.setVisible(False)
   End Sub

Offline

#17 24. 12. 2009 07:18:51

j-pastierik
Člen
Registrace: 15. 11. 2004
Příspěvků: 761

Re: Zlúčenie zošitov - Makro

Skúste namiesto globálnych premenných použiť obyčajný DIM - ak je pred procedúrami, poznajú jeho hodnotu. Na konci (za Next ProgressValue) vám chýba vymazanie dialógu z pamäte - odialog.dispose().

Na zistenie, či je dialóg viditeľný sa dá použiť aj metóda isVisible(), takže nepotrebujete globálne premenné a makro môžete upraviť takto (test "čosi=FALSE" môžete naprogramovať aj ako "NOT čosi")

'Zobrazenie dialógu
oDialog.setVisible(True)
             
For ProgressValue = ProgressValueMin To ProgressValueMax Step ProgressStep
  If not oDialog.isVisible() then exit for
        oProgressBarModel.setPropertyValue( "ProgressValue", ProgressValue )
        Wait 1000
    Next ProgressValue
   oDialog.Dispose()
   End Sub

   Sub UkoncitDialogOK
    oDialog.setVisible(False)
   End Sub

Editoval j-pastierik (24. 12. 2009 07:33:28)

Offline

#18 13. 1. 2010 13:15:13

P07
Člen
Registrace: 18. 1. 2008
Příspěvků: 42

Re: Zlúčenie zošitov - Makro

j-pastierik napsal(a)

Skúste namiesto globálnych premenných použiť obyčajný DIM - ak je pred procedúrami, poznajú jeho hodnotu. Na konci (za Next ProgressValue) vám chýba vymazanie dialógu z pamäte - odialog.dispose().

Na zistenie, či je dialóg viditeľný sa dá použiť aj metóda isVisible(), takže nepotrebujete globálne premenné a makro môžete upraviť takto (test "čosi=FALSE" môžete naprogramovať aj ako "NOT čosi")

Jediné čo môžem dodať je ďakujem

Editoval P07 (13. 1. 2010 13:19:10)

Offline

#19 25. 1. 2010 01:18:07

mirozm
Člen
Registrace: 9. 1. 2006
Příspěvků: 46

Re: Zlúčenie zošitov - Makro

Tak tu je ten sľúbený kód na "msgbox" ktorý sa zavrie za určitý čas. Už si to len uprav na funkciu

Ďakujem je to super zatiaľ som to neriešil a vďaka Tebe to už ani riešiť nemusím.
Skúšal som to ide to fajn,len som si pridal viac sekúnd a skrátil som čas (čakanie) na 80 tak ide ten progresbar plynulejšie.
Ani som sa poriadne na fórum ešte tento rok nepozrel (oddýchol som si od PC smile) a tak oddýchnutý už môžem zasa niečo "spáchať".
Ešte raz dík

Editoval mirozm (25. 1. 2010 01:18:38)


LO 5.1.6  platforma Ubuntu-linux 16.04

Offline

Zápatí