Skip to content

Instantly share code, notes, and snippets.

@ZipoKing
Created October 15, 2011 16:39
Show Gist options
  • Save ZipoKing/1289818 to your computer and use it in GitHub Desktop.
Save ZipoKing/1289818 to your computer and use it in GitHub Desktop.
Create tags cloud in LibreOffice/OpenOffice
REM ***** BASIC *****
' Copyright (c) 2010, Paweł Smoliński
' All rights reserved.
' Redistribution and use in source and binary forms, with or without
' modification, are permitted provided that the following conditions are
' met:
' * Redistributions of source code must retain the above copyright
' notice, this list of conditions and the following disclaimer.
' * Redistributions in binary form must reproduce the above copyright
' notice, this list of conditions and the following disclaimer in the
' documentation and/or other materials provided with the distribution.
' * Neither the name of the Paweł Smoliński nor the names of its
' contributors may be used to endorse or promote products derived from
' this software without specific prior written permission.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
' "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
' TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
' PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
' EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
' PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
' OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
' WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
' OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
' ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
' Utworzenie "chmury tagów" na podstawie danych pobranych z arkusza kalkulacyjnego:
' - z kolumny A ilości wystąpień danego wyrazu
' - z kolumny B same wyrazny
' - dane pobierane są z 1 arkusza, jeżeli mają być pobierane z innego należy odpowiednio zmodyfikować kod
' UWAGA! Z uwagi na to, iż kod ten pisany był pod konkretne rozwiązanie, posiada on tylko prosty mechanizm
' walidacji i oczekuje, iż użytkownik wprowadzi poprawne zakresy danych
Sub Main
Dim InputDoc as Object 'Dokument Calc'a
Dim Sheet as Object 'Pojedynczy arkusz
Dim Cell as Object 'Pojedyncza komórka w arkuszu
Dim ResultDoc as Object 'Wynikowy dokument tekstowy (Writer)
Dim TxtCursor as Object 'Kursor w dokumencie tekstowym
Dim Dummy() 'Pusta funkcja
Dim MinCol as Integer 'Minimalny indeks kolumny brany pod uwagę(dla A1=1, A3=3 itp.)
Dim MaxCol as Integer 'Maksymalny indeks kolumny brany pod uwagę
Dim I as Integer 'Zmienna pomocnicza
Dim C as Integer ' -"-
Dim W as String ' -"-
Dim MinHeight as Integer 'Minimalna wielkość czcionki, jaka zostanie użyta
Dim MaxHeight as Integer 'Maksymalna wielkość czcionki, jaka zostanie użyta
Dim HeightDiff as Integer 'Różnica w wielkości czcionki
Dim CurrHeight as Single 'Zmienna pomocnicza - wysokość bieżącego wyrazu
Dim MinCount as Integer 'Minimalna liczba wystąpień w podanym zestawie
Dim MaxCount as Integer 'Maksymalna liczba wystąpień w podanym zestawie
Dim CountDiff as Integer 'Różnica w liczbie wystąpień
Dim Cells as Object 'Zmienna pomocnicza - zbiór komórek opisujących liczbę wystąpień
Dim SpaceHeight as Integer 'Wysokość czcionki używanej przy wstawianiu spacji
Dim AddNumbers as Integer 'Informacja czy pokazywać obok wyrazów ilości wystąpień
SpaceHeight = 12 ' <=- Jeżeli czcionka dla spacji ma mieć inną wysokość, zmień tą wartość
' Wprowadzamy zakres wierszy, jakie będą brane pod uwagę
MinCol = InputBox("Wprowadź indeks pierwszego wiersza")
MaxCol = InputBox("Wprowadź indeks ostatniego wiersza")
' Prosta walidacja
If (MinCol < 1 or MaxCol < 1 or MinCol >= MaxCol) Then
MsgBox("Podano nieprawidłowe indeksy wierszy")
Exit Sub
End If
' Wprowadzamy graniczne wielkości czcionek
MinHeight = InputBox("Wprowadź minimalny rozmiar czcionki")
MaxHeight = InputBox("Wprowadź maksymalny rozmiar czcionki")
' Prosta walidacja
If (MinHeight < 1 or MaxHeight < 1 or MinHeight >= MaxHeight) Then
MsgBox("Podano nieprawidłowe wielkości czcionek")
Exit Sub
End If
' Pytanie o to czy pokazywać ilości wystąpień
AddNumbers = MsgBox("Pokazywać ilości wystąpień obok wyrazów?", MB_YESNO + MB_ICONQUESTION)
' Obliczamy Roznice wielkości czcionek
HeightDiff = MaxHeight - MinHeight
' Pobieramy instancję obiektu dokumentu oraz arkuszu
InputDoc = ThisComponent
Sheet = InputDoc.Sheets(0) ' <=- Tutaj dokonaj zmiany, jeżeli chesz operować na innym niż pierwszy arkusz
' Obliczamy maksymalną oraz minimalną liczbę wystąpień
Cells = Sheet.getCellRangeByName("A" + MinCol + ":A" + MaxCol)
MinCount = Cells.computeFunction(com.sun.star.sheet.GeneralFunction.MIN)
MaxCount = Cells.computeFunction(com.sun.star.sheet.GeneralFunction.MAX)
CountDiff = MaxCount - MinCount
If (CountDiff = 0) Then
CountDiff = 1
End If
'Tworzymy instancję nowego dokumentu tekstowego oraz kursora w tym dokumencie
ResultDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
TxtCursor = ResultDoc.Text.createTextCursor()
'Lecimy pokolei po wszystkich kolumnach
For I = MinCol To MaxCol
' Liczba wystąpień (C) oraz danych wyraz (W)
C = Sheet.getCellRangeByName("A" + I).Value
W = Sheet.getCellRangeByName("B" + I).String
If(AddNumbers = IDYES) Then
W = W + "(" + C + ")"
End If
' Obliczamy wysokość czcionki dla danego wyrazu i wstawiamy go do dokumentu
CurrHeight = MinHeight + HeightDiff * (C - MinCount)/CountDiff
TxtCursor.charHeight = CurrHeight
TxtCursor.String = W
TxtCursor.gotoEndOfParagraph(True)
' Wstawiamy spację
TxtCursor.charHeight = SpaceHeight
txtCursor.String = " "
TxtCursor.gotoEndOfParagraph(True)
Next I
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment