Makro kopiujące komórkę do zakresu, obszar do zakresu -Jak ?

[RysiekOpen]

Witam.
Siedzę od paru dni i nie mogę dojść jak skopiować zakres wiersza do wielu wierszy ?

Wiem jak skopiować zakres komórek do początku obszaru;
zakres B1:AO1 kopiuję do B11 i w ten sposób mam
cały zakres skopiowany do B11:AO11

Kod: Zaznacz cały

Sub Kopiuj_zakres
		oBB = ThisComponent.Sheets.getByName( "BB" )     					' arkusz BB

		oZrodlo = oBB.getCellRangeByPosition( 1, 0, 40, 0 ).getRangeAddress()
		oCell = oBB.getCellByPosition( 1, 10 ).getCellAddress()
		oBB.copyRange( oCell , oZrodlo ) 
End Sub

I to działa.

A teraz trzeba mi skopiować
z zakresu B1:AO40 do wielu wierszy czyli B11, B12, B13 ..... B2000

Teraz robię to tak;

Kod: Zaznacz cały

sub Kopiuj_wszystko_zapelnij
		oBB = ThisComponent.Sheets.getByName( "BB" )     					' arkusz BB
		oZrodlo = oBB.getCellRangeByPosition( 1, 0, 40, 0 ).getRangeAddress()
		For wiersz = 10 to 2000 
			oCell = oBB.getCellByPosition( 1, wiersz ).getCellAddress()
			oBB.copyRange( oCell , oZrodlo ) 
		Next
End Sub

I to też działa - tylko że długo.

Może ktoś mnie oświeci jak to zrobić kompleksowo bez pętli ?, Bo brak mi już pomysłów .... i cierpię ....

Pozdrawiam
Rysiek S.

[Jermor]

Tak na szybko, to najłatwiej jest po prostu nagrać to makro.
Nagrywając wskazać np. tylko dwa wiersze, żeby nie zaznaczać 2000, a potem w edytorze poprawić ten docelowy adres.
Będzie to wyglądało analogicznie do poniższego:

Kod: Zaznacz cały

sub Kopiuj_recorded
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$C$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$B$10:$B$16"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())


end sub

[Rafkus]

Nie wiem czy dobrze zrozumiałem:

A teraz trzeba mi skopiować
z zakresu B1:AO40 do wielu wierszy czyli B11, B12, B13 ..... B2000

czyli dane z tabeli posiadającej 40 wierszy i 40 kolumn chcesz przepisać do jednej kolumny?? Spróbuj tego:

Kod: Zaznacz cały

Sub Kopiuj_wszystko_zapelnij2
  oBB = ThisComponent.Sheets.getByName( "BB" )			' arkusz BB
  oZrodlo = oBB.getCellRangeByPosition(1, 0, 40, 40)	' źródło danych  
  for i=0 to 39		' ilość kolumn
     for j=0 to 39		' ilość wierszy
      Select Case oZrodlo.getCellByPosition(i, j).Type 
             Case com.sun.star.table.CellContentType.EMPTY 
                  oBB.getCellByPosition(1, 45 + i*40 + j).string  = ""
             Case com.sun.star.table.CellContentType.VALUE
                  oBB.getCellByPosition(1, 45 + i*40 + j).Value  = oZrodlo.getCellByPosition(i, j).Value
             Case com.sun.star.table.CellContentType.TEXT
                  oBB.getCellByPosition(1, 45 + i*40 + j).string  = oZrodlo.getCellByPosition(i, j).string
             Case com.sun.star.table.CellContentType.FORMULA
                  oBB.getCellByPosition(1, 45 + i*40 + j).Value  = oZrodlo.getCellByPosition(i, j).Value
      End Select
     next j
  next i   
   
End Sub

Jeżeli chcesz jakiś wiersz wkleić do jakieś kolumny to jak @Jermor proponujęnagrać makro wklej specjalnie(tam jest opcja transponowania):

Kod: Zaznacz cały

sub kopiuj_wklej_transponowane
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$B$1:$AO$1"		'zakres źródłowy

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$B$10:$B$2000"		'zakers docelowy

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(5) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Flags"
args4(0).Value = "SVD"
args4(1).Name = "FormulaCommand"
args4(1).Value = 0
args4(2).Name = "SkipEmptyCells"
args4(2).Value = false
args4(3).Name = "Transpose"
args4(3).Value = true
args4(4).Name = "AsLink"
args4(4).Value = false
args4(5).Name = "MoveMode"
args4(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())
end sub

[RysiekOpen]

[quote="Jermor"]Tak na szybko, to najłatwiej jest po prostu nagrać to makro.
Nagrywając wskazać np. tylko dwa wiersze, żeby nie zaznaczać 2000, a potem w edytorze poprawić ten docelowy adres.
Będzie to wyglądało analogicznie do poniższego:

Dzięki za odpowiedź.
To też brałem pod uwagę i zaimplementowałem - jest jednak ale;

problem - A.
- nie można tak robić na ukrytych (isVisible) Arkuszach, a ja tak mam ....
Nie jest to jakiś szczególny problem, trochę tylko nieładnie może wyglądać, ale problem B. większy;

problem - B.
- potrzebuję schowka dla użytkownika, a działa to tak;
1. użytkownik kopiuje sobie jakiś obszar Ctrl+C
2. korzysta z przycisku Makro aby przejść do innego Arkusza ( w trakcie działa ta funkcja )
3. użytkownik chce oddać schowek Ctrl+V
efekt ... zoonk ... użytkownik stracił to co skopiował, bo w schowku jest to co zrobił dispatcher

Chyba że znowu - jest jakiś myk na problem B. , żeby nie ruszał schowka użytkownika .... bo to następny

Pozdrawiam
Rysiek S.

[RysiekOpen]

Nie wiem czy dobrze zrozumiałem:

A teraz trzeba mi skopiować
z zakresu B1:AO40 do wielu wierszy czyli B11, B12, B13 ..... B2000

czyli dane z tabeli posiadającej 40 wierszy i 40 kolumn chcesz przepisać do jednej kolumny?? Spróbuj tego:

Przepraszam mea culpa ...
miało być;

z zakresu jednego wiersza B1:AO1 --> do wielu wierszy czyli B11, B12, B13 .... B2000 ( czyli obszarowo B11:AO2000 )

Podstawowym problemem dla mnie jest brak zakresu - tam gdzie kopiować

Takie rozwiązania jak poniżej ze zmianą wysokości wierszy w zakresie byłoby idealne ;
Tylko żeby to wymyślić to trzeba mieć łeb ....

Kod: Zaznacz cały

	'===============================================================================
	' Na piechotę zmiana wysokości wierszy w Arkuszuwygląda była taka;
		for wiersz = 10 to 5000
			oRow = oArkusz.getRows.getByIndex( wiersz )	' określamy tylko jeden wiersz i kicha .... brak innych metod ....
			oRow.Height = h_wiersza					' ustalamy jego wysokość ....
		next										' i to trwa ... i trwa ....
	' i nic nie mogłem znaleźć, bo nie było zakresu .......
	'===============================================================================
	'===============================================================================
	' ale później ktoś z głową rzekł ;

		oRow = oArkusz.getCellRangeByPosition( 0, 10, 0, 5000 )	' zakres wierszy 
		oRow.Rows.Height = h_wiersza	 					' jedna komenda dla całego zakresu !!!!!!

	' czyli zmieniam w zakresie wierszy wysokość każdego, i przestałem się głowić .....
	'===============================================================================

TAKIEGO CZEGOŚ potrzebuję do mojej operacji kopiowania - Narazie do kopiowania mam to;

'=================== kopiowanie wierszy ===================================
' kolumny od (1 do 20) w wierszu (5) jako obszar źródła (dla właściwego zrozumienia)
zrodlo = oBB.getCellRangeByPosition( 1, 5, 20, 5 ).getRangeAddress()
' kolumna (1) w wierszu (10) jako początek dla obszaru wklejania źródła
oGraf.copyRange( oGraf.getCellByPosition( 1, 10 ).getCellAddress(), zrodlo)
'--------- Ok następuje kopiowanie obszaru do początku nowego obszaru, tylko trzeba to powtórzyć n razy .....

'========================================================================
' i tu brakuje mi tego abym skopiował zrodlo do zakresu wierszy ..... coś takiego ....
' kolumna (1) i wiersze (od 10 do 2000) jako zakres wklejania początku obszaru (dla wklejenia źródła)
oGraf.copyRange( oGraf.getCellRangeByPosition( 1, 10, 1, 2000 ).getCellAddress(), zrodlo)
'--------- BŁĄD - nie chce wziąść sobie zakresu do tego aby tam poumieszczać wszystko za jednym zamachem .....

Mam nadzieję że teraz opisałem to w sposób zrozumiały, nie budzący wątpliwości.

Czy ma Ktoś jakieś pomysły ?

Albo żeby dispatcher nie przeszkadzał w pamięci podręcznej użytkownika, bo wtedy tak jak Koledzy wyżej opisali
byłaby możliwość jego użycia.

Pozdrawiam
Rysiek S.