[SOLVED] Makra do automatycznego sumowania wpisywanych liczb

[mick1]

Witam,
Stworzyłem sobie prosty arkusz kalkulacyjny w Excelu.
W nim mam 2 makra.
Chciałbym móc przenieść ten arkusz do OpenOffice, ale niestety nie działa.
Pierwsze makro ma sprawdzać (podczas zmiany w arkuszu), czy w kolumnie F zaszła zmiana. Jeżeli tak, to ma wywołać inne makro.

Kod: Zaznacz cały

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
 If ((Target.Column = 6) And (Target.Row > 1) And (Target.Value <> "")) Then Call Makro5(Target)
End If
End Sub

Makro5 ma wykonywać 2 operacje.
Wartość z kolumny E ma dodać do wartości w kolumnie E i wyczyścić wartość w kolumnie F

Kod: Zaznacz cały

Sub Makro5(ByVal Target As Range)
    Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + Target.Value
    Target.Value = ""
End Sub

niestety nijak nie chce mi to zadziałać w OpenOffice (a na języku OO nie znam się zupełnie).
Użyłem jakiegoś znalezionego w sieci konwertera, ale to, co wypluwa, też nie chce działać.
http://www.business-spreadsheets.com/vba2oo.asp
Bardzo proszę o pomoc w uruchomieniu tego czegoś.

[Jan_J]

O ile Makro5 jest rzeczywiście proste, to mechanizm wywołujący konkretne akcje w konkretnych sytuacjach różni się w Excelu i Calcu dość znacznie.
W Excelu istnieje ustalona konwencja określająca związek między okolicznościami wywołania procedury a jej nazwą. W Calcu trzeba zarejestrować obiekt, który prowadzi monitoring danego zdarzenia (w tym przypadku: zmianę wartości w kolumnie) i przypisuje mu wskazaną czynność. Są na ten temat 2 czy 3 wątki na forum; wpisz do rubryki <Szukaj> słowo "Listener". Na forach anglojęzycznych znajdziesz więcej szczegółów i przykładów.

Kodu teraz nie napiszę, bo nie mam czasu na testowanie. O ile ktoś mnie nie ubiegnie, wrócę do sprawy jutro.

Kilka różnic w obsłudze struktur danych Excela i Calca:
Worksheets(0) --> ThisComponent
Worksheet(0) -- ThisComponent.currentController.ActiveSheet
Worksheet(n) --> ThisComponent.Sheets(n-1)
Worksheet.Range("a1:b2") --> Sheet.GetCellRangeByName("a1:B2")
Worksheet.Range(komórka, komórka) --> Sheet.GetCellRangeByPosition(kol1, wiersz1, kol2, wiersz2)
Worksheet.Cells(wiersz, kolumna) --> Sheet.GetCellByPosition(kolumna-1, wiersz-1)
Cell.Value --> Cell.SetValue(x), x = Cell.GetValue()

[mick1]

Bardzo Ci dziękuję za pomoc.
Czy w Calcu po rejestracji takiego obiektu, może on się uruchamiać sam z siebie przy włączeniu arkusza, czy za każdym razem będę musiał go odpalać ręcznie?
Znalazłem kilka wątków na tym forum i innych, ale wszędzie jest funkcja, która uruchamia Listener i funkcja, która go zwalnia.

P.S.
Staram się zrozumieć składnię tego języka.
Na razie staram się stworzyć kod, który będę uruchamiał ręcznie (potem pomyślę o automatyzacji.
Korzystam z kodu, który znalazłem w świecie.
Nie rozumiem tylko za bardzo, jak mam przechwycić adres komórki, w której zdarzenie się stało.
Rozumiem, że brakuje mi jakiegoś polecenia, przypisującego do obiektu mojakomorka, obiekt, w którym zmiana się stała w miejscu

Kod: Zaznacz cały

REM  xxxx

Dodawaniem zajmę się później
Jak już poradzę sobie z wyciągnięciem adresu danej komórki, samo dodawanie i czyszczenie powinno być łatwe.
msgbox też oczywiście później zniknie.

Kod: Zaznacz cały

 Global oListener    As Object
 Global ocell as object
 Global mojakomorka as object
 Global docelowakomorka as object

Sub Remove_Listener
   ocell.removemodifyListener(oListener)
End Sub

Sub addlistener
ocell=thiscomponent.sheets(0).getcellrangebyname("F2:F6000")
    oListener = CreateUnoListener( "MyApp_", "com.sun.star.util.XModifyListener" )
ocell.addmodifylistener(olistener)
End Sub

Sub MyApp_disposing(oEvent)
   msgbox "disposing of the listener"
End Sub

Sub MyApp_Modified(oEvent)
REM  xxxx
    msgbox "Wartosc komorki "+str(mojakomorka.Source.Value)

End Sub

P.S.2
Samo dodawanie chciałbym zrealizować chyba w ten sposób. Jest łatwiejszy?

Kod: Zaznacz cały

If mojakomorka.value <>"" then

    docelowakomorka = thisComponent.sheets(0).getcellbyposition(mojakomorka.getcelladdress.Column-1,mojakomorka.getcelladdress.Row)
    docelowakomorka.setvalue = mojakomorka.value + docelowakomorka.value
    mojakomorka.setvalue=""
endif

[Jan_J]

Może tak? nasłuch zmian dotyczy bloku kolumnowego.
Zmiana wartości następuje w aktywnej komórce. W sytuacji, kiedy modyfikujemy komórkę, ale zaznaczony jest blok, jest to trudniejsze do zrobienia (por. AndrewMacro, r. 6.5).
Nasłuch ustawia się automatycznie w chwili otwarcia dokumentu.

Kod: Zaznacz cały

global d

rem w Narzędzia/Dostosuj/Zdarzenia trzeba przypisać do otwarcia dokumentu
Sub przyOtwarciu()
  nasluch(0, 100)
End Sub

Sub nasluch(kolumna, wiersze)
  d = thisComponent
  obszar = d.Sheets(0).getCellRangeByPosition(kolumna,1,kolumna,wiersze)
  lst = createUnoListener("my_", "com.sun.star.util.XModifyListener")
  obszar.addModifyListener(lst)
End Sub

rem pole evt.Source jest uchwytem nasłuchiwanego obszaru
Sub my_modified(evt)
  c = d.getCurrentSelection
  rem w sytuacji kiedy c jest komórką, jesteśmy w domu. gorzej, kiedy jest blokiem (tj. istnieje zaznaczenie)
  If c.SupportsService("com.sun.star.sheet.SheetCell") Then
    msgbox("komórka " & c.AbsoluteName & " ma wartość " & c.getString())
    rem tu aktualizujemy sumę
  Else
    msgbox("obszar " &  c.AbsoluteName & " nie powinien być zaznaczony")
  End If
End Sub

W sprawie

Kod: Zaznacz cały

If mojakomorka.value <>"" then

    docelowakomorka = thisComponent.sheets(0).getcellbyposition(mojakomorka.getcelladdress.Column-1,mojakomorka.getcelladdress.Row)
    docelowakomorka.setvalue = mojakomorka.value + docelowakomorka.value
    mojakomorka.setvalue=""
endif

jest prawie dobrze. Albo komorka.value = wartość, albo komorka.setValue(wartość). To ostatnie, o ile dobrze pamiętam, działa tylko dla danych liczbowych.

[mick1]

Bardzo dziękuję.
Wydaje mi się, że działa OK.
Mój kod:

Kod: Zaznacz cały

global d
Sub przyOtwarciu()
  nasluch()
End Sub

Sub nasluch()
  d = thisComponent
  obszar = d.Sheets(0).getCellRangeByPosition(5,1,5,2000)
  lst = createUnoListener("my_", "com.sun.star.util.XModifyListener")
  obszar.addModifyListener(lst)
End Sub

rem pole evt.Source jest uchwytem nasłuchiwanego obszaru
Sub my_modified(evt)
   
  c = d.getCurrentSelection
  rem w sytuacji kiedy c jest komórką, jesteśmy w domu. gorzej, kiedy jest blokiem (tj. istnieje zaznaczenie)
  If c.SupportsService("com.sun.star.sheet.SheetCell") Then
    If c.value <>"" then
    c2 = d.sheets(0).GetCellByPosition(4,c.getcelladdress.row)
    c2.setvalue(c2.getvalue()+c.getvalue())
    c.clearContents(1)
    End if
  Else
    msgbox("obszar " &  c.AbsoluteName & " nie powinien być zaznaczony")
  End If
End Sub

[Jan_J]

Z czystej ciekawości sprawdziłem, czy da się to napisać w Pythonie tak, żeby współgrało z Calcem. Po drobnych modyfikacjach wyszło:

Kod: Zaznacz cały

import uno
from unohelper import Base
from com.sun.star.util import XModifyListener

def przyOtwarciu(dummy):
	d = XSCRIPTCONTEXT.getDocument()
	obszar = d.Sheets.getByIndex(0).getCellRangeByPosition(5,1,5,2000)
	lst = myChange(d)
	obszar.addModifyListener(lst)

class myChange(XModifyListener, Base):
	def __init__(self, doc):
		self.doc = doc

	def modified(self, oEvent):
		c = self.doc.getCurrentSelection()
		# w sytuacji kiedy c jest komórką, jesteśmy w domu. gorzej, kiedy jest blokiem (tj. istnieje zaznaczenie)
		if c.supportsService("com.sun.star.sheet.SheetCell"):
			if c.getString() != "":
				adr = c.getCellAddress()
				c2 = self.doc.Sheets.getByIndex(adr.Sheet).getCellByPosition(adr.Column-1, adr.Row)
				c2.setValue(c2.getValue()+c.getValue())
				c.clearContents(1)
		else:
			# todo: print != msgbox
			print("obszar %s jest zaznaczony" % c.AbsoluteName)

	def disposing(self, oEvent):
		pass

(O niebo wolę Pythona od Basica. Python należy do języków obsługiwanych w OpenOffice. Problem w tym że w pakiecie nie ma dla niego narzędzi edycyjnych.)

Przy okazji poprawka warta wprowadzenia także do kodu w Basicu:

Kod: Zaznacz cały

rem zamiast
rem    c2 = d.sheets(0).GetCellByPosition(4,c.getcelladdress.row)
rem lepiej
    adr = c.getCellAddress
    c2 = d.Sheets(adr.Sheet).getCellByPosition(adr.Column - 1, adr.Row)

[mick1]

Masz rację.
Poprawka wprowadzona.
Jeszcze raz dziękuję za pomoc.

P.S.
Wolę zostać przy Basicu, bo mniej więcej już wiem, co tam się dzieje. Pythona nie znam zupełnie

[Kotek]

Witam,
pozwoliłem sobie trochę dostosować, do swoich potrzeb, te dwa proste przykładowe makra, zamieszczone wcześniej i działały wspaniale do momentu kiedy nie dodałem

Kod: Zaznacz cały

s.rows.removebyIndex(RowSrt, nRows)

Po dodaniu tej linijki kodu, (przy odpowiednich warunkach wejścia w to miejsce kodu), program się zapętla, tzn. program sam wchodzi w to miejsce po pierwszy wykonaniu tej linijki i można powiedzieć że wisi i kasuje w nieskończoność dalsze rzędy arkusza. Kiedy z powodu warunków linijka ta jest pomijana to program zachowuje się przewidywalnie, "zaremowanie" tej linijki też pomaga i program działa bez przeszkód, ale nie wykonuje oczywiście kasowania jednego wiersza arkusza. Próbowałem to debugować przez ładnych kilka dni, ale zabrakło mi już pomysłów, więc zwracam się z pytaniem, czy ktoś może wie co na to poradzić.

Moj pełny kod dwóch makr wygląda tak :

Kod: Zaznacz cały

global d
global licznik

Sub Main rem w Narzędzia/Dostosuj/Zdarzenia trzeba przypisać do otwarcia dokumentu
	
 licznik = 0
	
	d = thisComponent
	s = d.CurrentController.GetActiveSheet
	
	ColE = 4

	kolumna1 = ColE
	kolumna2 = ColE
	wiersz1 = 0
 	wiersz2 = s.RangeAddress.EndRow


	obszar = d.Sheets(s.RangeAddress.Sheet).getCellRangeByPosition(kolumna1, wiersz1, kolumna2, wiersz2)

  
	lst = createUnoListener("my_", "com.sun.star.util.XModifyListener")
	obszar.addModifyListener(lst)
	
REM	MsgBox "WSZYSTKO DOBRZE", 64 + 3 + 256, "MAIN ZAPUSZCZONE :)"
  
End Sub REM ------------------------------ KONIEC MAIN ---------------------------------------------------------



rem pole evt.Source jest uchwytem nasłuchiwanego obszaru
Sub my_modified(evt)


	c = d.GetCurrentSelection
	s = d.CurrentController.ActiveSheet

	ColSrt = 0  	
  	ColEnd = s.RangeAddress.EndColumn
	RowSrt = c.RangeAddress.StartRow
	RowEnd = c.RangeAddress.EndRow
	nRows = 1
	
	ColA = 0
	ColB = 1
	ColC = 2
	ColD = 3
	ColE = 4
	ColF = 5
	ColG = 6
	ColH = 7
	ColI = 8
	ColJ = 9
	

	i = RowEnd - RowSrt
	
	WHILE i >= 0
	
		c = s.GetCellByPosition(ColE, RowSrt + i)
	  	t = c.String
	  	
		
   		a = s.GetCellRangeByPosition(ColSrt, RowSrt + i, ColEnd, RowSrt + i)	rem	pole koloru
   		b = s.GetCellByPosition(ColG, RowSrt + i)								rem	komórka 
		p = s.GetCellByPosition(ColA, RowSrt + i)								rem	komórka prawidłowej daty
		e = s.GetCellByPosition(ColH, RowSrt + i)								rem	komórka misiąca
		
  	
  	Select Case t
  		Case "JEDEN"
			b.String = "JEDEN - 1"
		Case "DWA"
			b.String = "DWA - 2"
		Case "TRZY"
			b.String = "TRZY - 3"
		Case "CZTERY"
			b.String = "CZTERY - 4"
			
		Case Else

	 		s.rows.removebyIndex(RowSrt, nRows)
	 		
			msgbox "skasowane "
		
			Goto Endx

		End Select
		
		v = p.FormulaLocal
		If Mid(v, 3, 1) = "/" then		
		 		p.Formula = DateValue(v)		 		
		End If
		

Endx:		
		i = i - 1
		
	Wend
		

	licznik = licznik + 1
	msgbox licznik
End Sub REM ------------------------------ KONIEC my_modified ---------------------------------------------------------

Mam nadzieje że jest to prosty błąd do zlokalizowanie, bo bardzo mi to ułatwi żmudą i mechaniczną robotę.

[belstar]

Masz ustawiony nasłuch na wykrywanie zmian w danym zakresie, kiedy coś zmienisz w zadanym zakresie wywoływane jest makro my_modified(evt), w którym dodałeś linijkę usuwającą jakiś zakres i w tym momencie znów wywoływane jest to samo makro i pęta nieskończona gotowa, bo ciągle zakres ulega modyfikacji. Musisz wprowadzić jakiś warunek który, stwierdzi kiedy trzeba podjąć odpowiednie działanie.
Poszukaj na forum, kiedyś Jan_J wstawił rozwiązanie tego problemu. Poszukuj hasła Listener

[Kotek]

No jasne

Wielkie dzięki.
Takie proste jak się już wie, ale czasem zaplątanie w jakiś schemat myślowy zaciemnia całość.
Wprowadzę flagę wykonania kasowania.

Dziękuję

[Kotek]

A czy zmiana tła w takiej nasłuchiwanej komórce też może w jakiś sposób uruchomić makro, jaki listener trzeba dodać aby zmiana koloru tła wyzwała uruchomienie makra

Kod: Zaznacz cały

Sub my_modified(evt)

?

[Jan_J]

Jest cała hierarchia listenerów. Trzeba grzebnąć w dokumentacji, np. https://wiki.openoffice.org/wiki/Docume ... /Listeners