Macroの杜(LibreOffice Basic編)/ General No.4(3)

No.3 No.4(1) No.4(2) General No.4(3) No.5

図形描画（Shape）

[ ConnectorShape ]

GSCS-)[General]コネクタ形状（Connector Shape)[ com.sun.star.drawing.ConnectorType.STANDARD / com.sun.star.drawing.ConnectorType.CURVE / com.sun.star.drawing.ConnectorType.LINE / com.sun.star.drawing.ConnectorType.LINES / com.sun.star.drawing.ConnectorShape ]

Draw





Sub oDShapeProp
	Dim oPage
	Dim oRectangleShape
	Dim oShape    'Shape to insert
	DIm oConnType
	Dim oDoc
	Dim Dummy()
		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
		'
		oConnType = Array( _
						com.sun.star.drawing.ConnectorType.STANDARD, _
						com.sun.star.drawing.ConnectorType.CURVE, _
						com.sun.star.drawing.ConnectorType.LINE, _
						com.sun.star.drawing.ConnectorType.LINES, _
						)
		'
		oRectangleShape = Array( _
						oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
						oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
						oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
						oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
						)
		'
		oPage = createDrawPage(oDoc, "Test Draw", True)
		' Create RectAngle
		for i = 0 to 3
			oPage.add(oRectangleShape(i))
			oRectangleShape(i).setSize(CreateSize(2400, 2000))
		next i
		oRectangleShape(0).setPosition(CreatePoint(3000, 7000))
		oRectangleShape(1).setPosition(CreatePoint(8000, 4000))
		oRectangleShape(2).setPosition(CreatePoint(14000, 5000))
		oRectangleShape(3).setPosition(CreatePoint(8000, 9000))
	'
	' Set String and GluePoint
		for i = 0 to 3
			oRectangleShape(i).setString(i)
			' Connect Line( Curve )
			oShape = oDoc.createInstance("com.sun.star.drawing.ConnectorShape")
			oPage.add(oShape)
			oShape.StartShape = oRectangleShape(i)
			oShape.LineWidth = 50
			'Dash
			oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    		Dim oDash1 as New com.sun.star.drawing.LineDash
			Select Case i
				case 0
		   			With oDash1
    					.Style = com.sun.star.drawing.DashStyle.RECT
    					.Dots = 2
    					.DotLen = 100
    					.Dashes = 1    							
    					.DashLen = 750
    					.Distance = 100
    				End With
    				oShape.LineDash = oDash1
					'
					oShape.LineColor = RGB(255,0,0)
					'
					oShape.StartGluePointIndex = 0
					oShape.EndShape = oRectangleShape(i+1)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 0
					'
					oShape.LineStartName = "Arrow"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Square"
					oShape.LineEndWidth = 500
				case 1
					With oDash1
    					.Style = com.sun.star.drawing.DashStyle.ROUND
    					.Dots = 1
    					.DotLen = 100
    					.Dashes = 1
    					.DashLen = 750
    					.Distance = 200
    				End With
    				oShape.LineDash = oDash1
    				'
					oShape.LineColor = RGB(0,255,0)
					'
					oShapeStartGluePointIndex = 1
					oShape.EndShape = oRectangleShape(i+1)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 4
					'
					oShape.LineStartName = "Arrow"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Double Arrow"
					oShape.LineEndWidth = 500
				case 2
					With oDash1
    					.Style = com.sun.star.drawing.DashStyle.ROUND
    					.Dashes = 1
    					.DashLen = 200
    					.Distance = 200
    				End With
    				oShape.LineDash = oDash1
    				'
					oShape.LineColor = RGB(0,0,255)
					'
					oShape.StartGluePointIndex = 2
					oShape.EndShape = oRectangleShape(i+1)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 1
					'
					oShape.LineStartName = "Arrow"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Line"
					oShape.LineEndWidth = 500
				case 3
					With oDash1
    					.Style = com.sun.star.drawing.DashStyle.RECT
    					.Dots = 3
    					.DotLen = 100
    					.Dashes = 1
    					.DashLen = 750
    					.Distance = 100
    				End With
    				oShape.LineDash = oDash1
    				'
					oShape.LineColor = RGB(0,0,0)
					'
					oShape.StartGluePointIndex = 3
					oShape.EndShape = oRectangleShape(0)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 1
					'
					oShape.LineStartName = "Square 45"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Arrow"
					oShape.LineEndWidth = 500
			End Select
		next i
		msgbox "Success" & Chr$(13),0,"LO7.0.4.2(x64)"
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
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

'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
	Dim oPages
	Dim oPage
	Dim i%
		oPages = oDoc.getDrawPages()
		If oPages.hasByName(sName) Then
			If bForceNew Then
				oPages.remove(oPages.getByName(sName))
			Else
				createDrawPage = oPages.getByName(sName)
				Exit Function
			End If
		End If
		'
		oPage = oPages.getByIndex(oPages.getCount()-1)
		oPage.setName(sName)
		createDrawPage = oPage
End Function

[ GraphicObjectShape ]

GSGOb-)[General]グラフィックオブジェクト（Graphic Object)[ com.sun.star.drawing.GraphicObjectShape / .GraphicURL / .AdjustBlue / .AdjustGreen / .AdjustBlue / .AdjustContrast / .AdjustLuminance / .Transparency / com.sun.star.drawing.ColorMode.STANDARD ]

Draw






Sub oGraphicObj
	Dim oDoc
	Dim oPage As Object
	Dim oGraphicObjectShape As Object
	Dim oPoint As New com.sun.star.awt.Point
	Dim oSize As New com.sun.star.awt.Size
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_blank", 0, Dummy())
		oPage = oDoc.getdrawPages().getByIndex(0)
		'
		oPoint.x = 1000        
		oPoint.y = 1000
		oSize.Width = 10000
		oSize.Height = 10000
		' 
		oGraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
			oGraphicObjectShape.Size = oSize
			oGraphicObjectShape.Position = oPoint
		'
			oGraphicObjectShape.GraphicURL = "file:///c:/temp/graph.jpg"
			oGraphicObjectShape.AdjustBlue = -50
			oGraphicObjectShape.AdjustGreen = 5
			oGraphicObjectShape.AdjustBlue = 10
			oGraphicObjectShape.AdjustContrast = 20
			oGraphicObjectShape.AdjustLuminance = 50
			oGraphicObjectShape.Transparency = 40
			oGraphicObjectShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
		'
		oPage.add(oGraphicObjectShape)
End Sub

Calc






Sub oGraphicObj()
	Dim oDoc as Object
	Dim oPage As Object
	Dim oGraphicObjectShape As Object
	Dim oPoint As New com.sun.star.awt.Point
	Dim oSize As New com.sun.star.awt.Size
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
		oPage = oDoc.getdrawPages().getByIndex(0)
		'
		oPoint.x = 1000        
		oPoint.y = 1000
		oSize.Width = 10000
		oSize.Height = 10000
		' 
		oGraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
			oGraphicObjectShape.Size = oSize
			oGraphicObjectShape.Position = oPoint
		'
			oGraphicObjectShape.GraphicURL = "file:///c:/temp/graph.jpg"
			oGraphicObjectShape.AdjustBlue = -50
			oGraphicObjectShape.AdjustGreen = 5
			oGraphicObjectShape.AdjustBlue = 10
			oGraphicObjectShape.AdjustContrast = 20
			oGraphicObjectShape.AdjustLuminance = 50
			oGraphicObjectShape.Transparency = 40
			oGraphicObjectShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
		'
		oPage.add(oGraphicObjectShape)
End Sub

Writer






Sub oGraphicObj()
	Dim oDoc as Object
	Dim oPage As Object
	Dim oGraphicObjectShape As Object
	Dim oPosX as Integer, oPosY as Integer, oWidth as Integer, oHieght as Integer
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPage()
		'
		oPosX = 1000        
		oPosY = 1000
		oWidth = 10000
		oHieght = 10000
		' 
		oGraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
			'
			oGraphicObjectShape.GraphicURL = "file:///c:/temp/graph.jpg"
			oGraphicObjectShape.AdjustBlue = -50
			oGraphicObjectShape.AdjustGreen = 5
			oGraphicObjectShape.AdjustBlue = 10
			oGraphicObjectShape.AdjustContrast = 20
			oGraphicObjectShape.AdjustLuminance = 50
			oGraphicObjectShape.Transparency = 40
			oGraphicObjectShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
			'
		oPage.add(oGraphicObjectShape)
		'
		oPositionShape( oGraphicObjectShape, oPosX, oPosY,  oWidth, oHieght ) 
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
     Dim oPos as new com.sun.star.awt.Point
     	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     Erase oPos
 	'
     Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     Erase oSize
End Sub

[ OLE Shape ]

GSOLE-)[General]WriterにOLE Objectを挿入（Insert OLE Object)[ com.sun.star.text.TextEmbeddedObject / .CLSID / .AnchorType / .attach() / com.sun.star.text.TextContentAnchorType.AS_CHARACTER / .Model / .insertTextContent( , , ) / .uno:InsertObject ]

Writer Doc挿入






Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oSelections
  	Dim oSel
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oSelections =  oDoc.currentController().Selection
		oSel = oSelections.getByIndex(0)
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "8bc6b165-b1b2-4edd-aa47-dae2ee689dd6"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		oObj.attach(oSel)
		'
		oObjModel = oObj.Model
		'
		oObjModel.getText().setString("OLE Embedded Writer")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

' CLSIDの値
' 挿入するOLE Object（　Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6	Service name => com.sun.star.text.TextDocument
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f	Service name => com.sun.star.sheet.SpreadsheetDocument
' Chart		:	12dcae26-281f-416f-a234-c3086127382e	Service name => com.sun.star.chart.ChartDocument
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3	Service name => com.sun.star.drawing.DrawingDocument
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047	Service name => com.sun.star.presentation.PresentationDocument
' Math		:	078b7aba-54fc-457f-8551-6147e776a997	Service name => com.sun.star.formula.FormulaProperties

Calc Doc挿入






Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oCur = oText.createTextCursor()
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "47bbb4cb-ce4c-4e80-a591-42d9ae74950f"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		'
		' Chart 枠size
		oSize = CreateUnoStruct("com.sun.star.awt.Size")
  			oSize.Width = 10000
  			oSize.Height = 5000
  		oObj.setSize(oSize)
		'  
  		 oText.insertTextContent(oCur, oObj, False) 
		'
		Dim oSpreadSheetDoc
			oSpreadSheetDoc = oObj.getEmbeddedObject 
			oSheets = oSpreadSheetDoc.getSheets 
			oSheet = oSheets.getByIndex(0) 
			oSheet.getCellByPosition(0, 0).String = "OLE Calc Document in Writer" 
			oSheet.getCellByPosition(0, 1).Value = 10
			oSheet.getCellByPosition(0, 2).Value = 20
			oSheet.getCellByPosition(0, 3).Formula = "=A2+A3"
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

' CLSIDの値
' 挿入するOLE Object（　Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f
' Chart		:	12dcae26-281f-416f-a234-c3086127382e
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047
' Math		:	078b7aba-54fc-457f-8551-6147e776a997

Chart挿入






Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oCur = oText.createTextCursor()
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "12dcae26-281f-416f-a234-c3086127382e"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		'
		' Chart 枠size
		oSize = CreateUnoStruct("com.sun.star.awt.Size")
  			oSize.Width = 10000
  			oSize.Height = 10000
  		oObj.setSize(oSize)
		'  
  		oText.insertTextContent(oText.getEnd, oObj,False)
  		'
  		oChart = oObj.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 Writer" 
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

' CLSIDの値
' 挿入するOLE Object（　Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f
' Chart		:	12dcae26-281f-416f-a234-c3086127382e
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047
' Math		:	078b7aba-54fc-457f-8551-6147e776a997

Math Doc挿入






Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oCur = oText.createTextCursor()
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "078b7aba-54fc-457f-8551-6147e776a997"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		'
		oText.insertTextContent(oCur, oObj, true)
  		oObj.EmbeddedObject.Formula = "{1}over{2}" 
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

' CLSIDの値
' 挿入するOLE Object（　Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f
' Chart		:	12dcae26-281f-416f-a234-c3086127382e
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047
' Math		:	078b7aba-54fc-457f-8551-6147e776a997

OLE Objectを挿入Dialog表示






Sub InstOleObjDialog()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:InsertObject", "", 0, Array())
End Sub

[ Anchor ]

GSAhWr-)[General]WriterのAnchor設定（Writer Anchor settings)[ .AnchorType / com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH / com.sun.star.text.TextContentAnchorType.AT_PAGE ]

段落に設定



	

Sub oShapeWriter()
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPage()
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			'
			oDrawP.add(oShape)
			'
			oPositionShape( oShape, 1000, 1500,  3000, 3000 ) 
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH

     Dim oPos as new com.sun.star.awt.Point
     oPos.X = X
     oPos.Y = Y
     oShape.setPosition( oPos )
     Erase oPos
 
     Dim oSize as new com.sun.star.awt.Size
     oSize.Width = Width
     oSize.Height = Height
     oShape.setSize( oSize )
     Erase oSize
End Sub

Pageに設定




Sub oShapeWriter()
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPage()
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			'
			oDrawP.add(oShape)
			'
			oPositionShape( oShape, 1000, 1500,  3000, 3000 ) 
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	'
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
    Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
    Erase oSize
End Sub

GSAhCa-)[General]CalcのAnchor設定（Calc Anchor settings)[ .Anchor / .getCellRangeByName() / com.sun.star.sheet.SheetCell / .ShowAnchor / .uno:SetAnchorToCell / .getSpreadsheet() / .HoriOrientPosition / .VertOrientPosition / .uno:SetAnchorToPage ]

Cellに設定






Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oObj as Object
	Dim oObjAnchor as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
	' Position
		oPoint = oShape.Position
			oPoint.X = 1000
			oPoint.Y = 1000
		oShape.Position = oPoint
    ' Size
    	oSize = oShape.Size
    		oSize.Height = 1200		' unit : 1/100mm
    		oSize.Width =  1500		' unit : 1/100mm
    	oShape.Size = oSize
    oDrawP.add(oShape)
    '
    ' Anchorを　B3 Cell に設定( Shapeを移動させて設定 )
    	oObjAnchor = oShape.Anchor
    	with oShape
    		.Anchor = oObjAnchor.getCellRangeByName("B3")
    	end with
		'
	' Dispay Anchor
		oCtrl = oDoc.getCurrentController()	
		oCtrl.ShowAnchor = true
		oCtrl.select(oShape)
		'
	' AnchorがCellにあるかCheck → Cellに設定後 Anchor Objectを取得する必要がある
		oChk = oDrawP.getByindex(0).Anchor
		if oChk.supportsService("com.sun.star.sheet.SheetCell") then
    		oDisp = "Anchorを Cell に設定 → 成功"
    	else
    		oDisp = "Anchorを Cell に設定 → 失敗"
    	end if
    	msgbox oDisp,0,"Shape Anchor"
End Sub

Cellに設定(dispatcher)






Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
	' Position
		oPoint = oShape.Position
			oPoint.X = 1000
			oPoint.Y = 1000
		oShape.Position = oPoint
    ' Size
    	oSize = oShape.Size
    		oSize.Height = 1200		' unit : 1/100mm
    		oSize.Width =  1500		' unit : 1/100mm
    	oShape.Size = oSize
    oDrawP.add(oShape)
    '
    ' 作成したShapeを選択状態にする
    	oCtrl = oDoc.CurrentController()
    	oCtrl.select(oShape)
    	'
    ' AnchorをCell に設定
    	oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToCell", "", 0, Array())
		'
	' Anchor 
		oCtrl.ShowAnchor = true
    msgbox "Anchorを Cell に設定" 
End Sub

Sheetに設定






Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oObj as Object
	Dim oObjAnchor as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
	' Position
		oPoint = oShape.Position
			oPoint.X = 1000
			oPoint.Y = 2000
		oShape.Position = oPoint
    ' Size
    	oSize = oShape.Size
    		oSize.Height = 1200		' unit : 1/100mm
    		oSize.Width =  1500		' unit : 1/100mm
    	oShape.Size = oSize
    oDrawP.add(oShape)
    '
    ' AnchorをCurrnt PositionにてPageに設定
    	oObjAnchor = oShape.Anchor
    	with oShape
    		.Anchor = oObjAnchor.getSpreadsheet()
  			.HoriOrientPosition = oShape.HoriOrientPosition + oObjAnchor.Position.X
   			.VertOrientPosition = oShape.VertOrientPosition + oObjAnchor.Position.Y
    	end with
		'
	' Dispay Anchor
		oCtrl = oDoc.getCurrentController()	
		oCtrl.ShowAnchor = true
		oCtrl.select(oShape)
		'
	' AnchorがPageにあるかCheck → Cellに設定後 Anchor Objectを取得する必要がある
		oChk = oDrawP.getByindex(0).Anchor
		if oChk.supportsService("com.sun.star.sheet.Spreadsheet") then
    		oDisp = "Anchorを Page に設定 → 成功"
    	else
    		oDisp = "Anchorを Page に設定 → 失敗"
    	end if
    	msgbox oDisp,0,"Shape Anchor"
End Sub

Sheetに設定(dispatcher)






Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
	' Position
		oPoint = oShape.Position
			oPoint.X = 1000
			oPoint.Y = 1000
		oShape.Position = oPoint
    ' Size
    	oSize = oShape.Size
    		oSize.Height = 1200		' unit : 1/100mm
    		oSize.Width =  1500		' unit : 1/100mm
    	oShape.Size = oSize
    oDrawP.add(oShape)
    '
    ' 作成したShapeを選択状態にする
    	oCtrl = oDoc.CurrentController()
    	oCtrl.select(oShape)
    	'
    ' AnchorをCell に設定
    	oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToCell", "", 0, Array())
		'
	' Anchor 
		oCtrl.ShowAnchor = true
    msgbox "Anchorを Cell に設定",0,"Shape Anchor"
    '
    ' Anchorを Page に設定
    	oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToPage", "", 0, Array())
    msgbox "Anchorを Page に設定",0,"Shape Anchor"
End Sub

Macroの杜(Basic編)

No.3 No.4(1) No.4(2) General No.4(3) No.5