Makro z Excela w Open Office

[canny]

Witam wszystkich, potrzebuje przerobić makro działające pod Exelem na OO

Kod: Zaznacz cały

Sub Przepisywanie()
Dim nr_wiersza As Integer
nr_wiersza = 1
For Each wpisywany In Arkusz2.Range("A­5:A35")
If wpisywany.Value <> "" Then
Do While Arkusz3.Cells(nr_wier­sza, 1).Value <> ""
nr_wiersza = nr_wiersza + 1
Loop
Arkusz3.Cells(nr_wier­sza, 1).Value = wpisywany.Value
If Arkusz3.Cells(nr_wier­sza, 2).Value = "" Then
Arkusz3.Cells(nr_wier­sza, 2).Value = Date
End If
End If
Next
End Sub 

Niestety poległem na próbie samodzielnego przerobienia. Pokrótce opiszę czego potrzebuję. Chciał bym aby z Arkusza2 zawartości komórek od A5 do A35 zostały przeniesione do Arkusza3 i wklejone do kolumny pierwszej w pierwsze wolne wiersze zaczynając od góry. Komórki w arkuszu3 nie mają być nadpisywane tylko za każdym razem mają być przenoszone w pierwsze puste wiersze kolumny pierwszej. Na tym mi najbardziej zależy jeśli istnieje taka możliwość to chciał bym również aby w arkuszu3 w kolumnie 2 pojawiała się data przeniesienia zawartości komórek (uruchomienia makra data z zegara systemowego).
Z góry dziękuje za pomoc

[Jan_J]

W makrach Excela jest możliwe domyślne niejawne odwołanie do bieżącego dokumentu i jego “bieżących” składników. W Calcu nie ma.
Kilka innych różnic (nie wszystkie, oczywiście; tylko zarys logiki dostępu do arkusza):
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()

Jak już sobie poradzisz z różnicami wywołań bibliotecznych, i dalej nie będzie działać, wstaw tu nową wersję swojego kodu. Zobaczymy.

[canny]

Napisałem makro które przenosi zawartość komórek jedyny problem to nie mogę tak zmodyfikować tego makra żeby nie nadpisywało mi wierszy w arkuszu3, tylko wklejało w pierwsze puste komórki poniżej. Potrzebuje instrukcji która sprawdzi mi czy komórka jest pusta jeśli tak to wykonaj instrukcje przenoszenia jeśli nie to przejedz do następnej aż dojdzie do pierwszej pustej. Próbowałem z instrukcją if ale niestety nie działało.

Kod: Zaznacz cały

Sub przenoszenie_komorek
Dim oDoc As Object,oSheet as Object
Dim oCellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim oCellAddress As New com.sun.star.table.CellAddress
Dim nr_wiersza As Integer
nr_wiersza = 1
oDoc=ThisComponent
oSheet = oDoc.Sheets ("Arkusz1")	
oCellRangeAddress.Sheet = 1			'arkusz z którego mają być przenoszone dane
oCellRangeAddress.StartColumn = 0	        'kolumna
oCellRangeAddress.StartRow = 4		'początek zakresu do przeniesienia
oCellRangeAddress.EndColumn = 0		
oCellRangeAddress.EndRow = 34		'koniec zakresu do przeniesienia
oCellAddress.Sheet = 2				'arkusz do którego mają być przeniesione dane
oCellAddress.Column = 0				'kolumna do której mają być przeniesione dane
oCellAddress.Row = nr_wiersza		        'początek wklejania 
oSheet.moveRange(oCellAddress, oCellRangeAddress)
End Sub

Pozdrawiam

[Jan_J]

Twoje makro przenosi cały blok. To jest w porządku, bo trwa krócej niż przenoszenie komórka po komórce. Pytanie, czy chcesz ten blok mieć w całości?
Jeżeli tak, to trzeba znaleźć pierwszą pustą komórkę w danej kolumnie. Szkic poniżej.

Kod: Zaznacz cały

Sub Test_DoPierwszejPustejWKolumnie()
	nr_arkusza = 2
	nr_kolumny = 0
	nr_wiersza  = 0
	arkusz = thisComponent.Sheets.getByIndex(nr_arkusza)
	do while not IsCellRangeEmpty(arkusz.getCellByPosition(nr_kolumny, nr_wiersza))
	  nr_wiersza = nr_wiersza + 1
	loop
	Dim oCellAddress As New com.sun.star.table.CellAddress
	oCellAddress.Sheet = nr_arkusza
	oCellAddress.Column = nr_kolumny            'kolumna do której mają być przeniesione dane
	oCellAddress.Row = nr_wiersza              'początek wklejania 
        rem dalej Twój kod, albo opakuj to w funkcję
End Sub

Function IsCellRangeEmpty(oRange) As Boolean
  Dim oRanges      'Ranges returned after querying for the cells
  Dim oAddrs()     'Array of CellRangeAddress
 
  oRanges = oRange.queryContentCells(_
    com.sun.star.sheet.CellFlags.VALUE OR _
    com.sun.star.sheet.CellFlags.DATETIME OR _
    com.sun.star.sheet.CellFlags.STRING OR _
    com.sun.star.sheet.CellFlags.FORMULA)
  oAddrs() = oRanges.getRangeAddresses()
 
  IsCellRangeEmpty = UBound(oAddrs()) < 0
End Function

Użycie pętli while jest, że tak powiem, oczywiste. Funkcja sprawdzająca pustość zakresu, autorstwa Andrew Pitonyaka, pochodzi z http://www.oooforum.org/forum/viewtopic.phtml?t=12879
Prościej się nie da. Możesz testować komórkę na zawartość różną od "", ale to nie zda egzaminu jeżeli pusty napis będzie wyliczony prze formułę. Dlatego trzeba analizować koniunkcję zdań typu (Komórka nie posiada zawartości typu A) po wszystkich możliwych typach zawartości A.