Home of site


Macroの杜
(OpenOffice.org/LibreOffice Basic編)

Impress( Presentation )


**********************【 Index 】**********************


File



[ MasterPage ]


Page


[ Layout ]


Export


Shape


[ InterAction ]












**********************【 Macro Code 】**********************

File


IF-1)[Impress]新規Impress fileの開閉(保存確認無し)

Sub oImpressOpen
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oAns = Msgbox("ファイルを閉じますか?",4, "File Close確認")
		if oAns = 6 then
			oDoc.dispose
		End if
End Sub

IF-2)[Impress]新規Impress fileの開閉(保存確認有り)

Sub oImpressOpen_Save
	Dim Dummy() 
		oDoc = StarDesktop.loadComponentFromURL( "private:factory/simpress", "_blank", 0, Dummy())
 		oAns = Msgbox("fileを保存しますか?",4, "File Save確認")
 		 if oAns = 6 then
 		 	oInp = InputBox("Full pathでFile nameを入力して下さい(例 ： C:\temp\btest.odp)","保存File nameの入力")
 		 	If NOT IsNull(oInp) then
 		 		oIName = ConvertToUrl(oInp) 
 		 		oDoc.storeAsURL(oIName, Dummy())
 		 	End If
		End If
		oAnsC = MsgBox("Fileを閉じますか?",4,"Fileの終了確認")	
 		 If oAnsC = 6 then
 		 		oDoc.dispose
 		 End If
End Sub

[ MasterPage ]

IMP-1)[Impress]MasterPageの名前と番号取得


Sub oMasterImpress
	Dim oDoc
	Dim oDisp
	Dim oMpages
	Dim oMaster
	Dim oMasterName
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy()) 
		oMpages = oDoc.getMasterPages()
		oP = oMpages.getCount()-1
		oDisp = " [ MasterPage ]" & Chr$(10)
		for i = 0 to oP
			oMaster = oMpages.getByIndex(i)
			If oMaster.supportsService("com.sun.star.drawing.MasterPage") then
				oMasterName = oMaster.getName()
				oDisp = oDisp & "MasterPage番号 =　" & i & Chr$(10) _
						& "   Name　:  " & oMasterName()
			End If
			oDisp = oDisp & Chr$(10)
		next i
		msgbox(oDisp, 0, "[ Master Page ] ") 
End Sub

IMP-)[Impress]新規MasterPageの追加


Sub oMasterImp
	Dim oDoc
	Dim oDisp
	Dim oMpages
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oMpages = oDoc.getMasterPages()
		oMPages.insertNewByIndex(0)
End Sub

IMP-)[Impress]新規MasterPageの名前変更


Sub oMasterImp
	Dim oDoc
	Dim oFirstMpage
	Dim oNewMaster
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oFirstMpage = oDoc.getMasterPages()
		'
		oNewMaster = oFirstMpage.insertNewByIndex(0)
		oNewMaster.setName("NewMasetr01")
		'
	Dim oMpages
	Dim oP
	Dim oMaster
	Dim oMasterName
		oMpages = oDoc.getMasterPages()
		oP = oMpages.getCount()-1
		oDisp = " [ MasterPage ]" & Chr$(10)
		for i = 0 to oP
			oMaster = oMpages.getByIndex(i)
			If oMaster.supportsService("com.sun.star.drawing.MasterPage") then
				oMasterName = oMaster.getName()
				oDisp = oDisp & "MasterPage番号 =　" & i & Chr$(10) _
						& "   Name　:  " & oMasterName()
			End If
			oDisp = oDisp & Chr$(10)
		next i
		msgbox(oDisp, 0, "[ Master Page ] ") 
End Sub

IMP-)[Impress]

IMP-)[Impress]








Page

IP-1)[Impress]Page追加

Sub oAddPage
	Dim Dummy()
		oName = "C:\temp\oMacro_test(Impress).odp"
		oImp_file = ConvertToUrl(oName)
		oDoc = StarDesktop.loadComponentFromURL(oImp_file, "_blank", 0, Dummy()) 
		oImpPages = oDoc.getDrawPages()
		oImpPages.InsertNewByIndex(0) 
End Sub

IP-2)[Impress]Page削除

Sub oRemovePage
	Dim Dummy()
		oName = "C:\temp\oMacro_test(Impress).odp"
		oImp_file = ConvertToUrl(oName)
		oDoc = StarDesktop.loadComponentFromURL(oImp_file, "_blank", 0, Dummy()) 
		oPages = oDoc.getDrawPages()
		if oPages.getcount() >= 2 then
			oImpPage = oPages.getByIndex(1)
			oPName = oPages.remove(oImpPage)
		else
			Msgbox("削除するPageがありません。")
			Exit Sub
		End If
End Sub

IP-3)[Impress]Page名の取得

Sub oPageName
	Dim Dummy()
		oName = "C:\temp\oMacro_test(Impress).odp"
		oImp_file = ConvertToUrl(oName)
		oDoc = StarDesktop.loadComponentFromURL(oImp_file, "_blank", 0, Dummy()) 
		oImpPage = oDoc.getDrawPages().getByIndex(1)
		oPName = oImpPage.Name
		print oPName
End Sub

IP-4)[Impress]Page総数を取得

Sub oCountPage
	Dim Dummy()
		oName = "C:\temp\oMacro_test(Impress).odp"
		oImp_file = ConvertToUrl(oName)
		oDoc = StarDesktop.loadComponentFromURL(oImp_file, "_blank", 0, Dummy()) 
		oNum_pages = oDoc.getDrawPages().getcount() 
		Print oNum_pages & "Pages"
End Sub

IP-)[Impress]Current Page情報取得


Sub PageMacro()
	Dim oDoc as Object
	Dim oCurCtrl as Object
	Dim oCurPage as Object
	Dim oPageNo as Long
	Dim oPageName as String
	Dim oPageLayout as Long
	Dim oDisp as String
		oDoc = ThisComponent
		'
		oCurCtrl = oDoc.getCurrentController
		oCurPage = oCurCtrl.CurrentPage
		'
		oPageNo = oCurPage.Number
		oPageName = oCurPage.Name
		oPageLayout = oCurPage.Layout
		'
		oDisp = "[ Cuurent Page( Slide ) ]" & Chr$(10) & "Page No.  =  " & oPageNo & Chr$(10) & _
					"Page Name  = " & oPageName & Chr$(10) & "Page Layout No.  = " & oPageLayout
		msgbox(oDisp,0,"Current page")
End Sub

IP-)[Impress]PageのCopy


Sub PageMacro()
	Dim oDoc as Object
	Dim oPage as Object
	Dim oCopyPage as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oPage = oDoc.getDrawPages()
		'
		oCopyPage = oDoc.duplicate(oPage.getByIndex(0))	
		'
		oDisp = "Success"
		msgbox(oDisp,0,"Pageの複製")
End Sub
'
' Copy PageはCopy元も次Pageに配置される

IP-)[Impress]Current page in slide show


Sub SampleMacro
	Dim oPrnt as Object, oCtrl as Object
	Dim oSlidePage as Integer
	Dim oSDisp as String
		oPrnt = ThisComponent.getPresentation()
		oCtrl = oPrnt.getController()
		oSlidePage = oCtrl.CurrentSlideIndex + 1
		oSDisp = "現在のSlideは" & Chr$(10) & oSlidePage & " Pageです" 
		msgbox oSDisp,0,"Current Page No."
End Sub


IP-)[Impress]


[ Layout ]

IPLy-)[Impress]現在表示中のSlideのLayout番号取得


Sub oPageLayout
	Dim oDoc as Object
	Dim oCtrl as Object
	Dim oPage as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oPage = oCtrl.CurrentPage
		oPLayout = oPage.Layout
		msgbox (oPLayout, 0, "Layout番号")
End Sub

' 白紙のslide( Blunk Slide )	:	20
' Title Slide	:	0
' Title / Content	:	1
' Title and 2 Content	:	3
' Tiltle Only	:	19
' Centered Text	:	32
' Title / Object	:	11
' Title / Chart	:	2
' Title / Table	:	8
' Title, Clipart and Content	:	9
' Title, Content and Chart	:	4
' Title. Content and Clipart	:	6
' Title, Chart and Content	:	7
' Title, Content and Object	:	10
' Title, Content and 2 Object	:	12 
' Title, Object and Content	:	13
' Title, Object over Content	:	14
' Title, Content over Object	:	15
' Title, 2 Object and Cintent	:	16
' Title, Content over Object	:	17
' Title / 4 Object	:	18
' Title / 4 Clipart	:	33
' Title / 6 Clipart	:	34
' Vertial Title, Vertial Text and Chart	:	27
' Vertial Title / Vertial Text	:	28
' Title / Vertial Text	:	29
' Title, Vertial Text and Clipart	:	30

IPLy-)[Impress]Title SlideのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 0
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impres")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title, ContentのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 1
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impres")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title and 2 ContentのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 3
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impres")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Tiltle OnlyのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 19
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impres")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Centered TextのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 32
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impres")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title, ObjectのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 11
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impress")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title, ChartのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 2
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impress")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title. TableのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 8
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impress")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title, Clipart and ContentのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 9
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impress")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Vertial Title, Vertial TextのShapeType


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
	Dim oLayoutNo
		oLayoutNo = 28
		oPage.Layout = oLayoutNo 
		'
	Dim oShape
	Dim oSType
	Dim oShapeNum
		oDisp = "[ Layout No. =>  " & oLayoutNo & "  ]" &Chr$(10)& Chr$(10) 
		oShapeNum = oPage.getCount - 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			oSType = oShape.getShapeType()
			oDisp = oDisp & oSType & Chr$(10)
		next i
		msgbox(oDisp, 0, "Shape Type for Impress")
		'
		oDoc.dispose
End Sub

IPLy-)[Impress]Title, Content


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
		oPage.Layout = 1
		'
		oShapeNum = oPage.getCount - 1
		'
	Dim oShape
		m = 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
				oShape.setString("Slide 1 / Title Shape") 
			End If
			'
			If oShape.supportsService("com.sun.star.presentation.OutlinerShape") then
				oShape.setString("Slide 1 / Outliner Shape" & m)
				m = m +1 
			End If
		next i
		msgbox "Success"
End Sub

IPLy-)[Impress]Title and 2 Content


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
		oPage.Layout = 3
		'
		oShapeNum = oPage.getCount - 1
		'
	Dim oShape
		m = 1
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
				oShape.setString("Slide 1 / Title Shape") 
			End If
			'
			If oShape.supportsService("com.sun.star.presentation.OutlinerShape") then
				oShape.setString("Slide 1 / Outliner Shape" & m)
				m = m +1 
			End If
		next i
		msgbox "Success"
End Sub

IPLy-)[Impress]Title Only


Sub oPageLayoutImpress
	Dim oDoc
	Dim oPage
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
		oPage.Layout = 19
		'
		oShapeNum = oPage.getCount - 1
		'
	Dim oShape
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
				oShape.setString("Slide 1 / Title Shape") 
			End If
		next i
		msgbox "Success"
End Sub

IPLy-)[Impress]Title, Clipart and Content(未完成)

Sub PageLayoutImp()
	Dim oDoc as Object, oPage as Object
	Dim Dummy()
	Dim oShapeNum as Long
	Dim oObjFile as String
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPages().getByIndex(0)
		'
		oObjFile = "c:\temp\graph.jpg"
		oPage.Layout = 9
		'
		oShapeNum = oPage.getCount - 1
		'
	Dim oShape as Object
		for i = 0 to oShapeNum
			oShape = oPage.getByIndex(i)
			If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
				oShape.setString("Slide 1 / Title Shape") 
			End If
			'
			If oShape.supportsService("com.sun.star.presentation.OutlinerShape") then
				oShape.setString("Outliner Shape" ) 
			End If
			'
			If oShape.getShapeType = "com.sun.star.presentation.GraphicObjectShape" then
				oShape.GraphicURL = ConvertToUrl(oObjFile)
				oShape.AdjustBlue = -50
				oShape.AdjustGreen = 5
				oShape.AdjustBlue = 10
				oShape.AdjustContrast = 20
				oShape.AdjustLuminance = 50
				oShape.Transparency = 40
				oShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
			End If
		next i
		msgbox "Success"
End Sub








Export

IE-1)[Impress]各PageをJpeg形式でExport(XDrawPageSupplier)

Sub oExportJPG	
	oFilter = CreateUnoService("com.sun.star.drawing.GraphicExportFilter")
	Dim oExport(1) As new com.sun.star.beans.PropertyValue
	Dim Dummy()	
		oName = "C:\temp\oMacro_test(Impress).odp"
		oImp_file = ConvertToUrl(oName)
		oDoc = StarDesktop.loadComponentFromURL(oImp_file, "_blank", 0, Dummy()) 
		oNum_pages = oDoc.getDrawPages().getcount() 
		for i=0 to oNum_pages-1
			oPage = oDoc.getDrawPages().getByIndex(i)
			oPName = oPage.Name
			oFilter.setSourceDocument(oPage)
			oExport(0).Name = "URL"
			oExport(0).Value = "file:///c|/temp/" & oPName &".jpg"
			oExport(1).Name = "MediaType"
			oExport(1).Value = "image/jpeg"
			oFilter.filter(oExport())
		next i
		oDoc.dispose()
End Sub

IE-)[Impress]

Shape

ISp-)[Impress]他Slide内容を表示するShapeの追加


Sub oImpShape
	Dim oDoc
	Dim oDrawPage
	Dim oPoint
	Dim oSize
	Dim oThumbnail
		oDoc = ThisComponent
  		oDrawPage = oDoc.getDrawPages().getByIndex(0)
  			oPoint = CreateUnoStruct("com.sun.star.awt.Point")
  			oSize = CreateUnoStruct("com.sun.star.awt.Size")
  		for i = 2 to 4
  			oThumbnail = oDoc.createInstance("com.sun.star.drawing.PageShape")
 				oPoint.X = 2000
  				oPoint.Y = 1000 + 5000*(i-2) + 500
  				oSize.Width = 5000
  				oSize.Height = 5000
  				oThumbnail.setPosition(oPoint)
  				oThumbnail.setSize(oSize)
   				oDrawPage.add(oThumbnail)
  				oThumbnail.PageNumber = i
  		next i
End Sub

ISp-)[Impress]動画／画像を表示するShapeの追加

Sub oImpShape()
	Dim oDoc
	Dim oDrawPage
	Dim oPoint
	Dim oSize
	Dim oIShape
		oDoc = ThisComponent
  		oDrawPage = oDoc.getDrawPages().getByIndex(0)
  			oPoint = CreateUnoStruct("com.sun.star.awt.Point")
  			oSize = CreateUnoStruct("com.sun.star.awt.Size")
				oPoint.X = 2000
  				oPoint.Y = 1000
  				oSize.Width = 5000
  				oSize.Height = 5000
	'Media	
		oIShape = oDoc.createInstance("com.sun.star.drawing.MediaShape")
  			oIShape.setPosition(oPoint)
  			oIShape.setSize(oSize)
  		oDrawPage.add(oIShape)
  			oMediaFile = "C:\temp\clock.avi"
  		oIShape.MediaURL = ConvertToUrl(oMediaFile)
End Sub








IP-)[Impress]画像fileを挿入



Sub oAddPropGraphic
	Dim oDoc
	Dim oImpPage
	Dim oGraph
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
		oImpPage = oDoc.getDrawPages().getByIndex(0)
		oGraph = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
		oGName = "C:\temp\oBlue_hills.jpg"
		oGraph.GraphicURL = convertToUrl(oGName)
		oImpPage.add(oGraph)
		'Change Graphic Size
			Dim oNewSize As New com.sun.star.awt.Size
			Dim oBitMapSize As New com.sun.star.awt.Size			'Bitmap size
			Dim oImageRatio As Double									'Ratio of the height to width
			Dim oPageRatio As Double										'Ratio of the height to width
				oBitMapSize=oGraph.GraphicObjectFillBitmap.GetSize
				oImageRatio=CDbl(oBitMapSize.height) / CDbl(oBitMapSize.width)
				oPageRatio=CDbl(oImpPage.height) / CDbl(oImpPage.width)
				If oPageRatio > oImageRatio then
					oNewSize.width = oImpPage.width
					oNewSize.height = CLng(CDbl(oImpPage.width) * oImageRatio)
				else
					oNewSize.width = CLng(CDbl(oImpPage.height) / oImageRatio)
					oNewSize.height = oImpPage.height
				end if
			'Center the image on the page
				Dim oPosition As New com.sun.star.awt.Point
				oPosition.x = (oImpPage.width - oNewSize.width) / 2
				oPosition.y = (oImpPage.height - oNewSize.height) / 2
				
			oGraph.setSize(oNewSize)
			oGraph.setPosition(oPosition)			 
End Sub

ISp-)[Impress]Title Shapeの設定


Sub oImpShape
	Dim oDoc
	Dim oDrawPage
	Dim oPoint as new com.sun.star.awt.Point
	Dim oSize as new com.sun.star.awt.Size
	Dim oIShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
  		oDrawPage = oDoc.getDrawPages().getByIndex(0)
		'Position
			oPoint.X = 1000
  			oPoint.Y = 1000
  		'Size
  			'Get page size
  				oPageH = oDrawPage.Height
				oPageW = oDrawPage.Width
			'
			oSize.Height = 5000		' unit : 1/100 mm
  			oSize.Width =  oPageW - 1000*2
  	'
  		oIShape = oDoc.createInstance("com.sun.star.presentation.TitleTextShape")
  			oIShape.setPosition(oPoint)
  			oIShape.setSize(oSize)
  		oDrawPage.add(oIShape)
  		oIshape.setString("Slide 1 / Title Text Shape")   			
End Sub

ISp-)[Impress]SubTitle Shapeの設定


'Size / PositionはMaster Pageにて設定
Sub oImpShape
	Dim oDoc
	Dim oDrawPage
	Dim oIShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
  		oDrawPage = oDoc.getDrawPages().getByIndex(0)
 	'
  		oIShape = oDoc.createInstance("com.sun.star.presentation.SubtitleShape")
  		oDrawPage.add(oIShape)
  		oIshape.setString("Slide 1 / Subtitle Shape") 			
End Sub

ISp-)[Impress]Outliner Shapeの設定1


'Size / PositionはMaster Pageにて設定
Sub oImpShape
	Dim oDoc
	Dim oDrawPage
	Dim oIShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
  		oDrawPage = oDoc.getDrawPages().getByIndex(0)
 	'
  		oIShape = oDoc.createInstance("com.sun.star.presentation.OutlinerShape")
  	'	
  		oDrawPage.add(oIShape)
  			oDisp = "[ OutlinerShape ]"
  		oIShape.setString(oDisp)
  'Add OutLinerShape Text  	
  	oText = oIShape.getText()
  	oArg = createUnoStruct("com.sun.star.beans.PropertyValue")
   	' Level1 (with bullet)
   		oArg.Name = "NumberingLevel"
   		oArg.Value = 0    
   	oText.appendParagraph(Array(oArg))
   		oLevelText = "Level1-1" & Chr$(13) & "Level1-2"
   	oText.insertString(oText.getEnd(), oLevelText, False)
   	' Level2
   		oArg.Name = "NumberingLevel"
   		oArg.Value = 1
   	oText.appendParagraph(Array(oArg))
   		oLevelText = "Level2-1" & Chr$(13) & "Level2-2"
   	oText.insertString(oText.getEnd(), oLevelText, False)
   	' non outline
   		oArg.Value = nothing
   oText.appendParagraph(Array(oArg))
   oText.insertString(oText.getEnd(), "Non Outline", False)
End Sub

ISp-)[Impress]Outliner ShapeのNumbering Rules取得


Sub oImpShape
	Dim oDoc
	Dim oDrawPage
	Dim oSize as new com.sun.star.awt.Size
	Dim oIShape
		On Error Resume Next
		oDoc = ThisComponent
  		oDrawPage = oDoc.getDrawPages().getByIndex(0)
 	'
  		oIShape = oDoc.createInstance("com.sun.star.presentation.OutlinerShape")
  	'	
  		oDrawPage.add(oIShape)
  	'	oIShape.setName("Outliner")
  	'
  		oShape = oDrawPage.getByIndex(2)
 	'	oMRI = CreateUnoService("mytools.Mri")
	'	oMRI.inspect(oDrawPage)
		oObj_2 = oShape.createEnumeration()
  		oObj_4 = oObj_2.nextElement()
  		oNumberingRules = oObj_4.NumberingRules
  		oDisp =""
  	for j = 0 to 0	
  		oObj_5 = oNumberingRules.getByIndex(j)
  		
  		for i=0 to 12
  			oDisp = oDisp & oObj_5(i).Name
  			oDisp = oDisp & " => " & oObj_5(i).Value
  			oDisp = oDisp & Chr$(10)
  		next i
  	next j
  		msgbox oDisp
End Sub

ISp-)[Impress]OLE2Shapeの設定1


Sub oImpShape
	Dim oDoc
	Dim oImpPage
	Dim oPoint as new com.sun.star.awt.Point
	Dim oSize as new com.sun.star.awt.Size
	Dim oIShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
  		oImpPage = oDoc.getDrawPages().getByIndex(0)
  		oImpPage.Layout = 20
  		'
  		' TitleTextShape
		'Position
			oPoint.X = 1000
  			oPoint.Y = 1000
  		'Size
  			'Get page size
  				oPageH = oImpPage.Height
				oPageW = oImpPage.Width
			' Shape Size
			oSize.Height = 5000		' unit : 1/100 mm
  			oSize.Width =  oPageW - 1000*2
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.presentation.TitleTextShape")
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  				oIShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID
  			oImpPage.add(oIShape)
  				oIShape.setString("TitleTextShape")
  		'
  		'
  		' OLE2Shape
  		'Position
			oPoint.X = 1000
  			oPoint.Y = 6500
  		'Size
			' Shape Size
			oSize.Height = 10000		' unit : 1/100 mm
  			oSize.Width =  oPageW - 1000*2
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")		' <=  com.sun.star.presentation.OLE2ShapeはSlideに表示されない。
  			' Calc
  				oIShape.CLSID = "47bbb4cb-ce4c-4e80-a591-42d9ae74950f"
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  			oImpPage.add(oIShape)
  			'
			'
			Dim oEmbeded
			Dim oOLEComponent
			Dim oCalcSheets
			Dim oObj
				oEmbedded = oIShape.EmbeddedObject
				oOLEComponent = oEmbedded.getComponent()
 					oCalcSheets = oOLEComponent.getSheets()
 						oObj = oCalcSheets.getByIndex(0)
 							oObj.getCellByPosition(0,0).String = "OLE Calc Document in Impress"
 							oObj.getCellByPosition(0,1).Value = 10
 							oObj.getCellByPosition(0,2).Value = 20
 							oObj.getCellByPosition(0,3).Formula = "=A2+A3" 
 						' Cell Font
 							oObj.getCellRangeByPosition(0,0,0,3).CharHeight=40
 							oObj.getCellRangeByPosition(0,0,0,3).CharHeightAsian=40			
End Sub

ISp-)[Impress]OLE2Shapeの設定2


Sub oImpShape
	Dim oDoc
	Dim oImpPage
	Dim oPoint as new com.sun.star.awt.Point
	Dim oSize as new com.sun.star.awt.Size
	Dim oIShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
  		oImpPage = oDoc.getDrawPages().getByIndex(0)
  		oImpPage.Layout = 20
  		'
  		' TitleTextShape
		'Position
			oPoint.X = 1000
  			oPoint.Y = 1000
  		'Size
  			'Get page size
  				oPageH = oImpPage.Height
				oPageW = oImpPage.Width
			' Shape Size
			oSize.Height = 5000		' unit : 1/100 mm
  			oSize.Width =  oPageW - 1000*2
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.presentation.TitleTextShape")
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  				oIShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID
  			oImpPage.add(oIShape)
  				oIShape.setString("OLE2Shape / Chart")
  		'
  		'
  		' OLE2Shape
  		'Position
			oPoint.X = 1000
  			oPoint.Y = 6500
  		'Size
			' Shape Size
			oSize.Height = 10000		' unit : 1/100 mm
  			oSize.Width =  oPageW - 1000*2
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")	' <=  com.sun.star.presentation.ChartShapeではSlideには表示されるが、Slide Showに表示されない。
  			' Chart
  				oIShape.CLSID = "12dcae26-281f-416f-a234-c3086127382e"
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  			oImpPage.add(oIShape)
  			'
			Dim oChart
			Dim oCalcSheets
				oChart = oIShape.Model
  				oDiagram = oChart.createInstance("com.sun.star.chart.StackableDiagram")
				'
  				oChart.setDiagram(oDiagram)
  				oDiagram = oChart.getDiagram()
  				With oDiagram
    				.Stacked = True
    				.Percent = True
    				.Vertical = True
  				End With
			'
  				oChartData = oChart.getData()
  					Dim oData(1,3) As Double
  					' X Axis
  						oData(0,0) = 100.0
  						oData(0,1) = 50.0
  						oData(0,2) = 25.0
  						oData(0,3) = 12.5
  					' Y Axis
  						oData(1,0) = 100.0
  						oData(1,1) = 50.0
  						oData(1,2) = 25.0
  						oData(1,3) = 12.5
					'  			
  					oChartData.setData(oData)
  					'
  					' Cellの位置を設定
  						oChartData.setRowDescriptions(Array("Data 1", "Data 2"))
  						oChartData.setColumnDescriptions(Array("A", "B", "C", "D"))
					'
  						oChart.HasMainTitle = True
  						oTitle = oChart.Title
  						oTitle.String = "OLE Chart in Impress" 		
End Sub

ISp-)[Impress]OLE2Shapeの設定3


Sub oImpShape
	Dim oDoc
	Dim oImpPage
	Dim oPoint as new com.sun.star.awt.Point
	Dim oSize as new com.sun.star.awt.Size
	Dim oIShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_default", 0, Dummy()) 
  		oImpPage = oDoc.getDrawPages().getByIndex(0)
  		oImpPage.Layout = 20
  		'
  		' TitleTextShape
		'Position
			oPoint.X = 1000
  			oPoint.Y = 1000
  		'Size
  			'Get page size
  				oPageH = oImpPage.Height
				oPageW = oImpPage.Width
			' Shape Size
			oSize.Height = 5000		' unit : 1/100 mm
  			oSize.Width =  oPageW - 1000*2
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.presentation.TitleTextShape")
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  				oIShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID
  			oImpPage.add(oIShape)
  				oIShape.setString("TitleTextShape　and OLE2Shape Table / Chart")
  		'
  		'
  		' OLE2Shape
  		' Data
  		' Data数( 4data　=>　n=3)
  		n = 3
  		Dim oOrgData(1,n) As Double
  			' X Axis
  				oOrgData(0,0) = 100.0
  				oOrgData(0,1) = 50.0
  				oOrgData(0,2) = 25.0
  				oOrgData(0,3) = 12.5
  			' Y Axis
  				oOrgData(1,0) = 100.0
  				oOrgData(1,1) = 50.0
  				oOrgData(1,2) = 25.0
  				oOrgData(1,3) = 12.5
   		'
  		' Table
  		'Position
			oPoint.X = 3000
  			oPoint.Y = 6500
  		'Size
			' Shape Size
			oSize.Height = 10000		' unit : 1/100 mm
  			oSize.Width =  10000
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")		' <=  com.sun.star.presentation.OLE2ShapeはSlideに表示されない。
  			' Calc
  				oIShape.CLSID = "47bbb4cb-ce4c-4e80-a591-42d9ae74950f"
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  			oImpPage.add(oIShape)
			'
			Dim oEmbeded
			Dim oOLEComponent
			Dim oCalcSheets
			Dim oObj
				oEmbedded = oIShape.EmbeddedObject
				oOLEComponent = oEmbedded.getComponent()
 					oCalcSheets = oOLEComponent.getSheets()
 						oObj = oCalcSheets.getByIndex(0)
 							for i = 0 to n
 								oObj.getCellByPosition(0,i).Value = oOrgData(0,i)
 								oObj.getCellByPosition(1,i).Formula = "=A" & i+1 & "^2"
 								oOrgData(1,i) = oObj.getCellByPosition(1,i).Value
 							next i	
 						' 範囲
 						Dim oDataRange
 							oDataRange = oObj.getCellRangeByPosition(0,0,1,n) 						
 						' Cell Font
 							oDataRange.CharHeight=25
 							oDataRange.CharHeightAsian=25
 						' 列幅
 							oColumns = oDataRange.Columns
 							oColumns.Width=4000
 						' Cell内横位置
 							oDataRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER	'←横 中央揃え
 		'				' 罫線
							oTableBorder = CreateUnoStruct("com.sun.star.table.TableBorder")
							oLine = CreateUnoStruct("com.sun.star.table.BorderLine")
							' Line Property
								oLine.OuterLineWidth = 1
								oLine.InnerLineWidth = 0
								oLine.LineDistance = 0
								oLine.Color = RGB(0,0,0)
							'表用罫線外枠のライン指定
								oTableBorder.TopLine = oLine
								oTableBorder.BottomLine = oLine
								oTableBorder.LeftLine = oLine
								oTableBorder.RightLine = oLine
								'表用罫線外枠のライン表示のオン
									oTableBorder.IsTopLineValid = True
									oTableBorder.IsBottomLineValid = True
									oTableBorder.IsLeftLineValid = True
									oTableBorder.IsRightLineValid = True
							'表用罫線内側のライン指定
								oTableBorder.HorizontalLine = oLine
								oTableBorder.VerticalLine = oLine
								'表用罫線内側のライン表示のオン 
									oTableBorder.IsHorizontalLineValid = true
									oTableBorder.IsVerticalLineValid = true
							'範囲に表用罫線設定反映   
								oDataRange.TableBorder = oTableBorder
		'
		' OLE2Shape
  		'Position
			oPoint.X = 14000
  			oPoint.Y = 6500
  		'Size
			' Shape Size
			oSize.Height = 10000		' unit : 1/100 mm
  			oSize.Width =  10000
  		' Instance
  			oIShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")		' <=  com.sun.star.presentation.OLE2ShapeはSlideに表示されない。
  			' Chart
  				oIShape.CLSID = "12dcae26-281f-416f-a234-c3086127382e"
  				oIShape.setPosition(oPoint)
  				oIShape.setSize(oSize)
  			oImpPage.add(oIShape)
  			oChart = oIShape.Model
			oDiagram = oChart.createInstance("com.sun.star.chart.StackableDiagram")
				'
  				oChart.setDiagram(oDiagram)
  				oDiagram = oChart.getDiagram()
  				With oDiagram
    				.Stacked = True
    				.Percent = True
    				.Vertical = True
  				End With
			'
  				oChartData = oChart.getData()
  				oChartData.setData(oOrgData)
  					'
  					' Cellの位置を設定
  						oChartData.setRowDescriptions(Array("Data 1", "Data 2"))
  						oChartData.setColumnDescriptions(Array("A", "B", "C", "D"))
					'
  						oChart.HasMainTitle = True
  						oTitle = oChart.Title
  						oTitle.String = "OLE Chart in Impress"
End Sub

ISp-)[Impress]Note Shapeの設定

ISp-)[Impress]HandoutShapeの設定

ISp-)[Impress]








[ InterAction ]

ISpIA-)[Impress]前のPageに移動

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with PREVPAGE"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.PREVPAGE
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]次のPageに移動

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with NEXTPAGE"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.NEXTPAGE
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]最初のPageに移動

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with FIRSTPAGE"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.FIRSTPAGE
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]最後のPageに移動

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with LASTPAGE"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.LASTPAGE
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]任意のPage / Objectに移動

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with Bookmark"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.BOOKMARK
					oRectangleShape.Bookmark = "Slide5"
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]別Documentを開く

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with DOCUMENT"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.DOCUMENT
					oFileName = "c:\temp\oMacro_test_Draw02.odg"
					oURL = ConvertToURL(oFileName)
					oRectangleShape.Bookmark = oURL
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]Movie( wmv File )再生

Sub ShapeInterActionWmv()
	Dim oDoc as Object
	Dim oImpPage as Object
	Dim oSlide as Object
	Dim oShape as Object
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "Start wmv file !!"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.DOCUMENT
					oFileName = "C:\Users\Public\Videos\Sample Videos\Wildlife.wmv"
					oURL = ConvertToURL(oFileName)
					oRectangleShape.Bookmark = oURL
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function








ISpIA-)[Impress]Slideを非表示にする

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with INVISIBLE"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.INVISIBLE
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]音楽を流す

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with SOUND"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.SOUND
					oFileName = "C:\temp\sound\sample_sound.wav"
					oURL = ConvertToURL(oFileName)
					oRectangleShape.Bookmark = oURL
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function

ISpIA-)[Impress]VERB(未完成)

ISpIA-)[Impress]指定方法でObject( Shape等 )をFade out

Sub oShapeInterActionImpress
	Dim oDoc as Object
	Dim oImpPage as Object
	Dim oSlide as Object
	Dim oShape as Object
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "Varnish"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.Effect = com.sun.star.presentation.AnimationEffect.MOVE_TO_LEFT		' VANISHする時の動作を指定
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.VANISH
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint as Object
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize as Object
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function
'
' [ Note ]
'  com.sun.star.presentation.AnimationEffect について
'	.MOVE_TO_LEFT	:	左から右へObjectが消えていく。設定失敗の場合もある。（原因不明）
'	.MOVE_FROM_LEFT	:	Objectが無い状態でClickすると左からObjectが現れる。ObjectをCickしても動作無し。
'	.ZOOM_OUT_FROM_LEFT	:	設定不可

ISpIA-)[Impress]Programを実行( Writer,Calc,Draw,Impress,Base,Math で実行可能なFileのみ )


Sub oShapeInterActionImpress
	Dim oDoc as Object
	Dim oImpPage as Object
	Dim oSlide as Object
	Dim oShape as Object
	Dim oUno As New com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "Boot Writer Document"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL		' 日本語が入ると機能しない
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.PROGRAM
					oFileName = "C:\temp\LibreOfficeMacro.odt"
					oURL = ConvertToURL(oFileName)
					oRectangleShape.Bookmark = oURL
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function
' [ Note ]
' OpenOffice.org 2.3 等では他Applicationでも実行可能であった様です。

ISpIA-)[Impress]Macroを実行


Sub oShapeInterActionImpress
	Dim oDoc as Object
	Dim oImpPage as Object
	Dim oSlide as Object
	Dim oShape as Object
		oDoc = ThisComponent
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
				Dim oRectangleShape as Object
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "Execute Macro"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.MACRO
					oRectangleShape.Bookmark = "SampleMacro.Module1.Standard"
				'
			' Slide Show
			Dim oPres as Object
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint as Object
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize as Object
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function
'
'[ Macro ]
'マイマクロ → Standard → Modulue1 → SampleMacro
'
' ### [ Code ]  ###
'Sub SampleMacro
'	msgbox("Clickされました",0,"Macro in Slideshow")
'End Sub

ISpIA-)[Impress]Slide Show中止

Sub oShapeInterActionImpress
	Dim oDoc
	Dim oImpPage
	Dim oSlide
	Dim oShape
	Dim oUno As New com.sun.star.beans.PropertyValue
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
		oImpPage = oDoc.getDrawPages()
		'
		for i = 0 to 5 
			oImpPage.InsertNewByIndex(i)
			oSlide = oImpPage.getByIndex(i)
			oSlide.Name = "Slide" & i+1
			oSlide.Layout = 19
			'
			oShapeNume = oSlide.getCount() - 1
			for j = 0 to oShapeNume
				oShape = oSlide.getByIndex(j)
				If oShape.supportsService("com.sun.star.presentation.TitleTextShape") then
					oTitleText = " Slide - " & i+1
					oShape.setString(oTitleText)  
				End If
			next j
		next i
		' 
		' Slide2にBookMark付きShapeを作成
			oSlide = oImpPage.getByName("Slide2")
				' 四角形の中にTEXT
					oRectangleShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
					oSlide.add(oRectangleShape)
 						oRectangleShape.setPosition(createPoint(3000, 6000))
						oRectangleShape.setSize(createSize(12000, 3000))
						oRectangleShapeText = "OOoMacro with STOPPRESENTATION"
						oRectangleShape.setString(oRectangleShapeText)
						oRectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
						oRectangleShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
				'　影付き
					oRectangleShape.Shadow = True
				' InterAction
					oRectangleShape.OnClick = com.sun.star.presentation.ClickAction.STOPPRESENTATION
				'
			' Slide Show
			Dim oPres
				oPres = oDoc.getPresentation()
				' Slide Show中にPenを表示させる
				oPres.UsePen = True
				' Start
				oPres.Start()				
End Sub

'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
	Dim oPoint
		oPoint = createUnoStruct( "com.sun.star.awt.Point" )
		oPoint.X = x : oPoint.Y = y
		CreatePoint = oPoint
End Function


'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
	Dim oSize
		oSize = createUnoStruct( "com.sun.star.awt.Size" )
		oSize.Width = x : oSize.Height = y
		CreateSize = oSize
End Function


Top of Page

inserted by FC2 system