Create tags cloud in LibreOffice/OpenOffice

tags_cloud.bas

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