File
[ MasterPage ]
Page
[ Layout ]
Export
Shape
[ InterAction ]
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
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 ]
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
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
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
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
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
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
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
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
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に配置される
[ 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
'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
'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
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
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
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
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
[ InterAction ]
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
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
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
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
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
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
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
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
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
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 : 設定不可
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でも実行可能であった様です。
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
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