Automatyzacja za pomocą makr

[gpopiel]

Chciałbym zautomatyzować kilka rzeczy poprzez zastosowanie makr. Czy ktoś podpowie mi jak napisać makro aby:
1. wstawić grafikę do stopi
2. zmienić tło slajdu
3. uruchomić zapisane makr przy starcie prezentacji lub po naciśnięciu przycisku po czym usuwam przycisk z prezentacji.

[Minio]

Chciałbym zautomatyzować kilka rzeczy poprzez zastosowanie makr. Czy ktoś podpowie mi jak napisać makro aby:
1. wstawić grafikę do stopi
2. zmienić tło slajdu

Nie znam dokładnie Twojej sytuacji, ale jesteś przekonany, że nie możesz osiągnąć identycznych rezultatów przy pomocy wzorca slajdów?

[Jan_J]

Podstawowe zbiory przykładów A. Pitonyaka
http://www.pitonyak.org/oo.php
http://www.pitonyak.org/book

Warto się uczyć, chociaż nie zawsze warto na siłę stosować jedną technikę. O czym bardziej bezpośrednio wspomniał Minio.

[gpopiel]

Interesuje mnie konkretne zastosowanie z użyciem VBA. Dlatego o nie pytam.

Może ktoś z was ma jakieś kody?

[belstar]

Chciałbym zautomatyzować kilka rzeczy poprzez zastosowanie makr.

Impress は Draw と同じコンポーネントを利用しています。違うのはプレゼンテーション関連の部分のみです。そのため、一般的なことは Draw と同じです。

Polskie tłumaczenie:
Impress pozwala korzystać z takich samych komponentów jak Draw. Różnica jest tylko część związanej z prezentacją

Żeby udowodnić ci to uruchom poniższy kod, który tworzy dokument Impressa i wstawia do niego obiekty z kolekcji shape.

Kod: Zaznacz cały

Sub Main
   
   ' Create a new Draw document.
   ' You could change this line to load a drawing that has a page
   '  whose dimensions you have altered.
   ' Or change "sdraw" for "simpress".
   'oDrawDoc = StarDesktop.loadComponentFromURL( "private:factory/sdraw", "_blank", 0, Array() )
   oDrawDoc = StarDesktop.loadComponentFromURL( "private:factory/simpress", "_blank", 0, Array() )
   
   ' Get the first page.
   oPage = oDrawDoc.getDrawPages().getByIndex( 0 )
   
   
   '----------------------------------------
   ' Parameters for the design.  Feel free to tweak these numbers.
   
   ' Number blocks across and down
   '  (Serving suggestion: try changing these numbers to, say, 12.)
   nNumBlocksAcross = 20
   nNumBlocksDown = 15
   
   ' Location of the *group* of color blocks
   '  measured from top left edge, and bottom right edge.
   ' Measured in 1000'ths of cm.  So 500 means 1/2 cm.
   ' Since there are 2.54 inches per cm, you can multiply inches by 2450.
   nHorizMargin = 2450 * 0.25 ' 1/4 inch
   nVertMargin = 2450 * 0.25 ' 1/4 inch
   
   ' The spacing between blocks.
   nBlockHMargin = 2450 * 1/12 ' 1/12 inch
   nBlockVMargin = 2450 * 1/12 ' 1/12 inch
   '
   '----------------------------------------
   
   
   ' Now calculate everything else based on the parameters,
   '  and so that it fits precisely on the drawing page,
   '  no matter what its dimensions or margins.
   
   ' Initial X,Y coordinates of top row, left column.
   nBlockFirstX = oPage.BorderLeft + nHorizMargin
   nBlockFirstY = oPage.BorderTop + nVertMargin
   
   ' Block width adapts to page width, based on above parameters.
   nBlockWidth = (oPage.Width - oPage.BorderRight - oPage.BorderLeft - nHorizMargin - nHorizMargin + nBlockHMargin) / nNumBlocksAcross _
                     - nBlockHMargin
   
   ' The block height is a function of the row.
   nPageHeight = oPage.Height - oPage.BorderTop - oPage.BorderBottom - nVertMargin - nVertMargin
   nColorBarHeight = nPageHeight - (nBlockVMargin * (nNumBlocksDown-1))
   nAvgBlockHeight = nColorBarHeight / nNumBlocksDown
   nInitialBlockHeight = nAvgBlockHeight * 1.5
   nFinalBlockHeight = nAvgBlockHeight * 0.5
   
   nBlockHeight = nInitialBlockHeight
   nBlockHeightChangePerRow = (nFinalBlockHeight - nInitialBlockHeight) / (nNumBlocksDown - 1)
   
   
   '----------
   ' Draw a big page filling black rectangle.
   oShape = MakeRectangleShape( oDrawDoc, MakePoint( oPage.BorderLeft, oPage.BorderTop ),_
                  MakeSize( oPage.Width - oPage.BorderLeft - oPage.BorderRight,_
                           oPage.Height - oPage.BorderTop - oPage.BorderBottom ) )
   oShape.FillColor = 0 ' black
   oPage.add( oShape )
   '----------
   
   
   '----------------------------------------
   ' Draw a group of blocks.
   ' As the row increases....
   '   The saturation decreases from 1.0 to 0.2.
   '   The heights of the rows decreases.
   ' As the column increases....
   '    The hue changes from 0.0 to almost 1.0.
   ' The brightness remains constant on all blocks -- full brightness.
   
   nBrightness = 1.0
   
   ' Initial Y coordinate for first row.
   nY = nBlockFirstY
   
   For nRow = 0 To nNumBlocksDown-1
      ' The color saturation is a function of the row.
      nSaturation = (nNumBlocksDown-nRow) / nNumBlocksDown

      ' Initial X coordinte for first column.
      nX = nBlockFirstX
      
      ' Make size object for the size of each block.   
      oSize = MakeSize( nBlockWidth, nBlockHeight )
      
      For nCol = 0 To nNumBlocksAcross-1
         ' The color hue is a function of the column.
         nHue = nCol / (nNumBlocksAcross + 2)
         
         ' Create next rectangle shape, set its color.
         oShape = MakeRectangleShape( oDrawDoc, MakePoint( nX, nY ), oSize )
'Żeby nie instalować biblioteki HSB wyłączyłem tą linie
         'oShape.FillColor = HSB( nHue, nSaturation, nBrightness )
         oPage.add( oShape )
         
         ' Adjust X coordinate for next column.
         nX = nX + (nBlockWidth + nBlockHMargin)
      Next
      
      ' Adjust Y coordinate for next row.
      nY = nY + (nBlockHeight + nBlockVMargin)
      
      ' The block height is a function of the row.
      nBlockHeight = nBlockHeight + nBlockHeightChangePerRow
   Next
   '
   '----------------------------------------
End Sub


'----------
'   Create and return a new Point object.
'
'   This is syntax sugar to make it easy to
'    create a com.sun.star.awt.Point object.
'
Function MakePoint( x As Long, y As Long ) As com.sun.star.awt.Point
   aPoint = CreateUnoStruct( "com.sun.star.awt.Point" )
   aPoint.x = x
   aPoint.y = y
   MakePoint = aPoint
End Function


'----------
'   Create and return a new Size object.
'
'   This is syntax sugar to make it easy to
'    create a com.sun.star.awt.Size object.
'
Function MakeSize( width As Long, height As Long ) As com.sun.star.awt.Size
   aSize = CreateUnoStruct( "com.sun.star.awt.Size" )
   aSize.width = width
   aSize.height = height
   MakeSize = aSize
End Function


'----------
'   Create and return a RectangleShape object.
'
'   After you create the shape object, you can manipulate
'    its properties to alter its appearance, including
'    its size and location.
'
'   You must pass the document object.
'   Optionally, you may also pass in a location and size.
'   If you do not, then the new object has size (0,0)
'    and location (0,0), which is the extreme upper left.
'    In other words, the object is squished way up in the
'    upper left corner, and has no size, therefore cannot be seen.
'
Function MakeRectangleShape( oDrawDoc As Object,_
               Optional position As com.sun.star.awt.Point,_
               Optional size As com.sun.star.awt.Size ) As com.sun.star.drawing.RectangleShape
   oShape = oDrawDoc.createInstance( "com.sun.star.drawing.RectangleShape" )
   If Not IsMissing( position ) Then
      oShape.Position = position
   EndIf
   If Not IsMissing( size ) Then
      oShape.Size = size
   EndIf
   MakeRectangleShape() = oShape
End Function

Potem zmień linię odpowiedzialną za utworzenie nowego dokumentu na Draw.

Kod: Zaznacz cały

oDrawDoc = StarDesktop.loadComponentFromURL( "private:factory/sdraw", "_blank", 0, Array() )

Kod nie zgłasza żadnych błędów, tworząc dokładnie to samo co poprzednio, tylko że w Draw. Dlatego poszukuj przykładów odnośnie Draw, a jest ich sporo więcej.
Np. tu


Kod uruchamiający i zatrzymujący prezentacje

Kod: Zaznacz cały

Sub startPrez
Dim oDoc As Object
Dim oPre As Object

  oDoc = ThisComponent
  oPre = oDoc.getPresentation()
  oPre.start()
  wait 10000
  oPre.end()
End Sub

[gpopiel]

Potrzebuje rozwiązania w VBA.
Chciałbym pod przyciskiem uruchomić makro, które wykona następujące czynności:
1.Skopiuje zawartość aktualnego całego slajdu , czyli stworzy drugi slajd z takim samymi ustawieniami (stopką, kolorami czcionki, tekstem, obiektami...)
2.Wstawi prawidłową numeracje stron
3.Wykasuje przycisk, z którego zostało uruchomione powyższe makro

Możecie mi podrzucić taki kod?

[belstar]

1.Skopiuje zawartość aktualnego całego slajdu , czyli stworzy drugi slajd z takim samymi ustawieniami (stopką, kolorami czcionki, tekstem, obiektami...)

Kod: Zaznacz cały

Sub WstawDuplikat() 
	Dim oDoc		as Object 
	Dim oPage		as Object 
	Dim oCopyPage	as Object 
	
	oDoc		=	ThisComponent
	oPage		=	oDoc.getDrawPages() 
	oCopyPage	=	oDoc.duplicate(oPage.getByIndex(0)) 
End Sub

2.Wstawi prawidłową numeracje stron

Makro z punktu pierwszego, duplikat wstawia za stroną źródłową, czy to dobrze, czy źle? nie wiem

Co do trzeciego punktu, to podałem ci link do przykładów dla Draw, a tam wśród wielu rozwiązań znajdziesz kod wstawiający "jakąś" kontrolkę do formularza, analizując go, przerobisz kod na usuwający kontrolkę (przycisk) z formularza. Na pewno będzie to coś w tym stylu:

Kod: Zaznacz cały

oShape.Control = oControlModel
oForm.insertByIndex( 0, oControlModel )
oPage.add( oShape )
'oPage.remove(oShape)

[Jan_J]

Czy technikę z metodą oDoc.Duplicate() dałoby się zastosować między dokumentami?
W http://forum.openoffice.org/pl/forum/vi ... =10&t=2037 użyłem wywołań UNO dispatchera: Copy i Paste, ale nie byłem zadowolony.

[belstar]

Czy technikę z metodą oDoc.Duplicate() dałoby się zastosować między dokumentami?

Ano nie wiem, w niedziela potestujem.

[belstar]

Niestety, testy wykazały że duplikat tworzony jest tylko w obrębie dokumentu z którego wywołana jest metoda.

[Jan_J]

Tak sądziłem, kiedy zadawałem pytanie. I moje własne próby wykazują to samo.