Strona 1 z 1
Makro z Excela w Open Office
: wt lis 15, 2011 1:05 am
autor: 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("A5:A35")
If wpisywany.Value <> "" Then
Do While Arkusz3.Cells(nr_wiersza, 1).Value <> ""
nr_wiersza = nr_wiersza + 1
Loop
Arkusz3.Cells(nr_wiersza, 1).Value = wpisywany.Value
If Arkusz3.Cells(nr_wiersza, 2).Value = "" Then
Arkusz3.Cells(nr_wiersza, 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
Re: Makro z Excela w Open Office
: wt lis 15, 2011 11:12 am
autor: 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.
Re: Makro z Excela w OpenOffice
: śr lis 16, 2011 10:16 am
autor: 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
Re: Makro z Excela w Open Office
: śr lis 16, 2011 7:17 pm
autor: 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.