Home of site

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

Calc No.4

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

View( com.sun.star.sheet.SpreadsheetViewSettings Service )

CVw-)[Calc]Page Preview Mode/Normal Mode表示[ .uno:PagebreakMode / NormalViewMode ]
CVw-)[Calc]Page Breake Line表示/非表示[ ShowPageBreaks ]
CVw-)[Calc]式入力Boxの表示/非表示[ .uno:InputLineVisible ]
CVw-)[Calc]関数Listの表示/非表示[ .uno:FunctionBox ]
CVw-)[Calc]行･列番号表示/非表示(1)[ .uno:ViewRowColumnHeaders ]
CVw-)[Calc]行･列番号表示/非表示(2)[ ColumnRowHeaders ]
CVw-)[Calc]行･列番号表示/非表示(3)[ HasColumnRowHeaders ]
CVw-)[Calc]値の強調表示/非表示(1)[ .uno:ViewValueHighlighting ]
CVw-)[Calc]値の強調表示/非表示(2)[ ValueHighlighting ]
CVw-)[Calc]値の強調表示/非表示(3)[ IsValueHighlightingEnabled ]
CVw-)[Calc]画面Zoomの設定( Only Calc )[ ZoomType / ZoomValue ]
CVw-)[Calc]Gride Line表示/非表示[ ShowGrid ]
CVw-)[Calc]Gride Lineの色設定[ GridColor ]
CVw-)[Calc]Spell記号の表示/非表示(未完成)[ HideSpellMarks ]
CVw-)[Calc]水平Scroll Bar表示/非表示[ HorizontalScrollBar ]
CVw-)[Calc]垂直Scroll Bar表示/非表示[ VerticalScrollBar ]
CVw-)[Calc]Outline記号の表示/非表示(1)[ OutlineSymbols ]
CVw-)[Calc]Outline記号の表示/非表示(2)[ IsOutlineSymbolsSet ]
CVw-)[Calc]DocumentのSheet Tabの表示/非表示(1)[ SheetTabs ]
CVw-)[Calc]DocumentのSheet Tabの表示/非表示(2)[ HasSheetTabs ]
CVw-)[Calc]DocumentのSheet Tab表示/非表示Check[ HasSheetTabs / com.sun.star.sheet.DocumentSettings / com.sun.star.comp.SpreadsheetSettings ]
CVw-)[Calc]Object Anchorの表示/非表示[ ShowAnchor ]
CVw-)[Calc]Objectの表示/非表示[ ShowDrawing ]
CVw-)[Calc]ObjectのHelp Line表示/非表示[ ShowHelpLines ]
CVw-)[Calc]Embedded Objectの表示/非表示[ ShowObjects ]
CVw-)[Calc]Formula表示[ ShowFormulas ]
CVw-)[Calc]Zero( = 0 )表示/非表示[ ShowZeroValues ]
CVw-)[Calc]Commentの表示/非表示(1)[ setIsVisible ]
CVw-)[Calc]Commentの表示/非表示(2)[ .uno:NoteVisible ]
CVw-)[Calc]Comment Markの表示/非表示[ ShowNotes ]
CVw-)[Calc]Option → Rasterの設定取得[ IsSnapToRaster / ]
CVw-)[Calc][ ]

Document Setting( com.sun.star.sheet.SpreadsheetDocumentSettings Service : LibreOffice / Apache OpenOffice )

CSDS-)[Calc]Auto Spell Check ON/OFF( Only Calc )[ .SpellOnline ]
CSDS-)[Calc]OpenXml形式で保存する時のDefaultTabStop値取得[ ]
CSDS-)[Calc][ ]

Data Pilot

CDP-)[Calc]Data Pilot Sourceの作成[ DimArray / setDataArray / NumberFormats / com.sun.star.lang.Locale / .HoriJustify ]
CDP-)[Calc]Data Pilot Tableの作成
[ Randomize() / getRangeAddress() / getDataPilotTables() / setSourceRange / createDataPilotDescriptor() / Orientation / com.sun.star.sheet.DataPilotFieldOrientation.ROW / com.sun.star.sheet.DataPilotFieldOrientation.COLUMN / com.sun.star.sheet.DataPilotFieldOrientation.DATA / Function / com.sun.star.sheet.GeneralFunction.SUM ]
CDP-)[Calc]Data Pilot Tableの削除[ removeByName(name) ]
CDP-)[Calc]Pilot Table作成Dialog表示[ .uno:DataDataPilotRun ]

GoalSeek[ com.sun.star.sheet.GoalResult ]

CGS-)[Calc]GoalSeek[ SeekGoal() / .Result / .Divergence ]
CGS-)[Calc]GoalSeek Dialog表示[ .uno:GoalSeekDialog ]
CGS-)[Calc][ ]

Scenario

CSro-)[Calc]Scenarioの作成/削除(1)[ getScenarios() / addNewByName(,,) / removeByName() ]
CSro-)[Calc]Scenarioの作成/削除(2)[ .uno:ScenarioManager / .uno:DeleteScenario ]
CSro-)[Calc]Properties of Service Scenario[ getByName / IsActive / BorderColor / Protected / ShowBorder / PrintBorder / CopyBack / CopyStyles / CopyFormulas ]
CSro-)[Calc]ScenarioのCommnet取得/設定[ getScenarioComment / setScenarioComment() ]
CSro-)[Calc]Scenarioの有無Check[ hasElements() ]
CSro-)[Calc]名前を指定してScenarioの有無Check[ hasByName() ]
CSro-)[Calc][ ]

Graph Chart作成

CGhCt-)[Calc]各種Graph作成(0)[ .getCharts() / .hasByName() / .RemoveByName() / addNewByName(,,,,) / .embeddedObject ]
CGhCt-)[Calc]各種Graph作成(1)[ com.sun.star.chart.XYkDiagram / .HasMainTitle / .Title.String / .diagram.HasXAxisTitle / .diagram.XAxisTitle.String / .diagram.HasYAxisTitle / .diagram.YAxisTitle.String / .diagram.XAxis.TextBreak / .diagram.XAxis.TextRotation ]
CGhCt-)[Calc]各種Graph作成(1A)[ .Subtitle / .HasLegend ]
CGhCt-)[Calc]各種Graph作成(2)[ com.sun.star.chart.LineDiagram ]
CGhCt-)[Calc]各種Graph作成(3)[ .getFirstDiagram() / .getChartTypeManager() / com.sun.star.chart2.template.ScatterLineSymbol / .changeDiagram() ]
CGhCt-)[Calc]Graph作成Wizard表示(1)[ .uno:InsertObjectChart ]
CGhCt-)[Calc]Graph作成Wizard表示(2)[ .uno:DrawChart ]
CGhCt-)[Calc]Chart AreaのProperties[ .getArea() / .FillStyle / .FillBackground / .FillColor / .FillTransparence / .LineStyle / .LineWidth / .LineColor / .LineTransparence / .getDiagram() / getWall() ]
CGhCt-)[Calc]Data SeriesのProperties[ .getFirstDiagram() / .getCoordinateSystems() / .getChartTypes() / .getDataSeries() / .Color ]

画像

CGrc-1)[Calc]画像dataの挿入[ dispatcher / FileName / FilterName / AsLink ]

印刷操作

CP-)[Calc]改Pageの挿入/解除(1)[ IsStartOfNewPage ]
CP-)[Calc]改Pageの挿入/解除(2)[ .uno:InsertRowBreak / DeleteRowbreak / InsertColumnBreak / DeleteColumnbreak ]
CP-)[Calc]全ての改Pageの解除[ .uno:DeleteAllBreaks ]
CP-)[Calc]印刷範囲を設定する[ setPrintAreas() / getPrintAreas() / HasUnoInterfaces() ]
CP-)[Calc]印刷範囲を削除する[ .uno:DeletePrintArea ]
CP-)[Calc]Column TitleをONにする[ setPrintTitleColumns(boolean) / getPrintTitleColumns() / HasUnoInterfaces() ]
CP-)[Calc]Column Title範囲を設定する[ setTitleColumns(ranges) / getTitleColumns() / HasUnoInterfaces() ]
CP-)[Calc]Row TitleをONにする[ setPrintTitleRows(boolean) / getPrintTitleRows() / HasUnoInterfaces() ]
CP-)[Calc]Row Title範囲を設定する(1)[ setTitleRows() / getTitleRows() / HasUnoInterfaces() ]
CP-)[Calc]Row Title範囲を設定する(2)[ .uno:ChangePrintArea ]
CP-)[Calc]印刷倍率を設定[ .PageScale ]
CP-)[Calc]印刷倍率を設定をReset[ .uno:ResetPrintZoom ]
CP-)[Calc]Header/Footer Dialog表示[ uno:EditHeaderAndFooter ]
CP-)[Calc][ ]

[ Prinetr ]

CPPrt-)[Calc]Default Printer Name取得[ PrinterName / com.sun.star.comp.SpreadsheetSettings ]
CPPrt-)[Calc][ ]
CPPrt-)[Calc][ ]

file操作

CF-1)[Calc]新規Calc fileの開閉(保存確認無し)
CF-2)[Calc]新規Calc fileの開閉(保存確認有り)
CF-3)[Calc]指定のCalc fileを開く(c:\temp\test.ods)
CF-4)[Calc]CSV形式fileを開く。
CF-)[Calc]Html形式Fileを開く
CF-)[Calc]SYLK形式( Symbolic Link File : MS-Multiplan )形式Fileを開く
CF-)[Calc]xls形式( MS-Excel 2003 )Fileを開く
CF-)[Calc]xlsx形式( MS-Office 2007 )Fileを開く
CF-)[Calc]MS-Excel 2003 XML形式Fileを開く
CF-)[Calc]Documentの保護/保護解除( Only Calc )[ .isProtected() / .protect() / .unprotect() ]
CF-)[Calc]「Documentの保護」Dialog表示( Only Calc )[ .uno:ToolProtectionDocument ]
CF-)[Calc]

CSV file操作

CCsv-1)[Calc]CSV Fileの作成

Web関係

CWeb-)[Calc]Yahoo FinanceよりGoogleの株価CSVファイルを開いてExcel形式で保存( Old )
CWeb-)[Calc]Yahoo FinanceよりStock( Google )のHistorical Price取得

その他

CO-)[Calc]全Sheetにおいてセルの背景色（Red)の累計を数える
CO-)[Calc]Excelのパスワード付ファイルを開ける
CO-)[Calc]「挿入」⇒「外部データへのリンク」Dialog表示[ .uno:InsertExternalDataSource ]
CO-)[Calc][ ]

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

View

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' Page Preview Mode
		oDispatcher.executeDispatch( oFrame, ".uno:PagebreakMode", "", 0, Array())
		msgbox "Page Break Preview",0,"View"
		' Normal Mode
		oDispatcher.executeDispatch( oFrame, ".uno:NormalViewMode", "", 0, Array())
		msgbox "Normal Mode",0,"View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oCtrl.ShowPageBreaks = true
		msgbox "Page Break Line表示",0,"View"
		' Normal Mode
		oCtrl.ShowPageBreaks = false
		msgbox "Page Break Line非表示",0,"View"
End Sub

Sub CalcUnoView()
	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")
		'
			oProp(0).Name = "InputLineVisible"
			oProp(0).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:InputLineVisible", "", 0, oProp())
		msgbox "式入力Box非表示",0,"View"
		'
			oProp(0).Name = "InputLineVisible"
			oProp(0).Value = true
		oDispatcher.executeDispatch( oFrame, ".uno:InputLineVisible", "", 0, oProp())
		msgbox "式入力Box表示",0,"View"
End Sub

Sub CalcUnoView()
	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")
		'
			oProp(0).Name = "FunctionBox"
			oProp(0).Value = true
		oDispatcher.executeDispatch( oFrame, ".uno:FunctionBox", "", 0, oProp())
		msgbox "関数List表示",0,"View"
		'
			oProp(0).Name = "FunctionBox"
			oProp(0).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:FunctionBox", "", 0, oProp())
		msgbox "関数List非表示",0,"View"
End Sub

Sub CalcUnoView()
	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:ViewRowColumnHeaders", "", 0, oProp())
		msgbox "行、列番号非表示",0,"View"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ViewRowColumnHeaders", "", 0, oProp())
		msgbox "行、列番号非表示",0,"View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.ColumnRowHeaders = false
		msgbox "行、列番号非表示",0,"CalcView"
		'
		oCtrl.ColumnRowHeaders = true
		msgbox "行、列番号表示",0,"ClacView"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.HasColumnRowHeaders = false
		msgbox "行、列番号非表示",0,"CalcView"
		'
		oCtrl.HasColumnRowHeaders = true
		msgbox "行、列番号表示",0,"ClacView"
End Sub

Sub CalcUnoView()
	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:ViewValueHighlighting", "", 0, oProp())
		msgbox "値の強調表示ON" & Chr(10) & "Colorが付く",0,"View"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ViewValueHighlighting", "", 0, oProp())
		msgbox "値の強調表示OFF" & Chr(10) & "Blackに戻る",0,"View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.ValueHighlighting = true
		msgbox "値の強調表示ON" & Chr(10) & "Colorが付く",0,"CalcView"
		'
		oCtrl.ValueHighlighting = false
		msgbox "値の強調表示OFF" & Chr(10) & "Blackに戻る",0,"ClacView"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.IsValueHighlightingEnabled = true
		msgbox "値の強調表示ON" & Chr(10) & "Colorが付く",0,"CalcView"
		'
		oCtrl.IsValueHighlightingEnabled = false
		msgbox "値の強調表示OFF" & Chr(10) & "Blackに戻る",0,"ClacView"
End Sub

Sub WindowZoom()
	Dim oDoc as Object, oCtrl as Object
    Dim oZoom1 as Long, oZoom2 as Long
    Dim oDisp as String
    	oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		' Current Zoom
		oZoom1 = oCtrl.ZoomValue
		'
		oCtrl.ZoomValue = 125	' 拡大率を指定するときのみ ZoomValue を使用
		' ZoomType は ZoomValueの後にする事.
		'oCtrl.ZoomType = 3							' こちらでもOK	
		oCtrl.ZoomType = com.sun.star.view.DocumentZoomType.BY_VALUE
		'
		oZoom2 = oCtrl.ZoomValue
		oDisp = "[ View → Zoom ]" & Chr$(10) & "Before = " & oZoom1 & Chr$(10) & "After = " & oZoom2
    	'
    msgbox(oDisp,0,"画面Zoom")
End Sub
'
' [ Note ]
' 1) ZoomType の値が .uno:Zoom と異なる事に注意。
' 
' 		OPTIMAL						:	0	/ 選択範囲に合わせる
' 		PAGE_WIDTH					:	1	/ ページ幅に合わせる
' 		ENTIRE_PAGE					:	2	/ 縦横ページ全体を表示
' 		BY_VALUE						:   3	/ 拡大率を指定してズーム
' 		PAGE_WIDTH_EXACT		:	4	/ 正確なページ幅
'
' 2) Calc以外は .uno:Zoom使用。Calcも .uno:Zoom で設定できる。

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.ShowGrid = false
		msgbox "Grid線を非表示",0,"CalcView"
		'
		oCtrl.ShowGrid = true
		msgbox "Grid線表示",0,"ClacView"
End Sub
'
' [ Note ]
' Calc Only / WriterではError

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.GridColor = &HFF0000	' Red
		msgbox "Success"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.HideSpellMarks = false
		msgbox "Auto Spell Check / ON",0,"Spell Check"
		'
		oCtrl.HideSpellMarks = false
		msgbox "Auto Spell Check / OFF",0,"Spell Check"
End Sub
'
' [ Note ]
' Errorは生じないが、Spell記号(赤字の下波線)のON/OFF反応無し。( LibreOffice4.0.1 , Apache OpenOffice3.4 )
' LO, AOO 共に com.sun.star.sheet.SpreadSheetViewSetting Serviceに記載有り。
' Auto Spell Check( Spell記号の表示/非表示 )ならばOK

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.HorizontalScrollBar = false
		msgbox "水平Scroll Bar非表示",0,"Calc View"
		'
		oCtrl.HorizontalScrollBar = true
		msgbox "水平Scroll Bar表示",0,"Calc View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.VerticalScrollBar = false
		msgbox "垂直Scroll Bar非表示",0,"Calc View"
		'
		oCtrl.VerticalScrollBar = true
		msgbox "垂直Scroll Bar表示",0,"Calc View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' 事前準備
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox "Goup化　OK",0,"Display"
		'
		oCtrl = oDoc.getCurrentController()
		oCtrl.OutlineSymbols = false
		msgbox "OutlineSymbol非表示",0,"Calc View"
		'
		oCtrl.OutlineSymbols = true
		msgbox "OutlineSymbol表示",0,"Calc View"
		'
		oSheet.clearOutline()
		msgbox "Success"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' 事前準備
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox "Goup化　OK",0,"Display"
		'
		oCtrl = oDoc.getCurrentController()
		oCtrl.IsOutlineSymbolsSet = false
		msgbox "OutlineSymbol非表示",0,"Calc View"
		'
		oCtrl.IsOutlineSymbolsSet = true
		msgbox "OutlineSymbol表示",0,"Calc View"
		'
		oSheet.clearOutline()
		msgbox "Success"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oCtrl.SheetTabs = false
		msgbox "Sheet Tab非表示",0,"Calc View"
		'
		oCtrl.SheetTabs = true
		msgbox "Sheet Tab表示",0,"Calc View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oCtrl.HasSheetTabs = false
		msgbox "Sheet Tab表示 ? = " & oCtrl.HasSheetTabs ,0,"Calc View"
		'
		oCtrl.HasSheetTabs = true
		msgbox "Sheet Tab表示 ? = " & oCtrl.HasSheetTabs,0,"Calc View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
	Dim oSpdSht as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oCtrl.SheetTabs = false
		'
		oSpdSht = oDoc.createInstance("com.sun.star.sheet.DocumentSettings")
		Rem oSpdSht = oDoc.createInstance("com.sun.star.comp.SpreadsheetSettings")	' ← こちらでもOK
		msgbox "Sheet Tab表示 ? = " & oSpdSht.HasSheetTabs ,0,"Calc View"
		'
		oCtrl.SheetTabs = true
		msgbox "Sheet Tab表示 ? = " & oSpdSht.HasSheetTabs,0,"Calc View"
End Sub
'
' [ Note ]
' com.sun.star.sheet.DocumentSettings / com.sun.star.comp.SpreadsheetSettings では設定不可
' 設定するには CurrentController() ( つまり com.sun.star.sheet.SpreadsheetViewSettings ) を使う

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		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())
		'
	' 一度、Objectの選択を解除 / Cell を選択
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A10"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
	' Anchor 表示/非表示 
		oCtrl.ShowAnchor = false
		oCtrl.select(oShape)
		msgbox "ObjectのAnchor非表示",0,"Calc View"
		'
		oCtrl.ShowAnchor = true
		oCtrl.select(oShape)
		msgbox "ObjectのAnchor表示",0,"Calc View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape 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)
	'
	' 図形Object 表示/非表示
		oCtrl = oDoc.getCurrentController()
		oCtrl.ShowDrawing = true
		msgbox "図形Objectの非表示" & Chr$(10) & "( ShowDrawing )",0,"Calc View"
		'
		oCtrl.ShowDrawing = false
		msgbox "図形Objectの表示" & Chr$(10) & "( ShowDrawing )",0,"Calc View"
End Sub
'
' [ Note ]( LibreOffice4.0.1 )
' true  : Not Display
' false : Display

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oCtrl.ShowHelpLines = false
		msgbox "Show Help Line = " & oCtrl.ShowHelpLines ,0,"Calc View"
		'
		oCtrl.ShowHelpLines = true
		msgbox "Show Help Line = " & oCtrl.ShowHelpLines,0,"Calc View"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		' 事前に Embedded Objectを作成
		oCtrl.ShowObjects = 1
		msgbox "Embed Objectの非表示",0,"Calc View"
		'
		oCtrl.ShowObjects = 2	
		msgbox "Image 枠 表示",0,"Calc View"
		'
		oCtrl.ShowObjects = 0
		msgbox "Embed Objectの表示",0,"Calc View"
End Sub
'
' [ Note ]
' oCtrl.ShowObjects = 2 では Image枠のみで無く、全体が表示されてしまう( LO4.0.1 )

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.ShowFormulas = true
		msgbox "数式表示",0,"CalcView"
		'
		oCtrl.ShowFormulas = false
		msgbox "値表示",0,"ClacView"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.ShowZeroValues = false
		msgbox "Zero( = 0 ) 非表示",0,"CalcView"
		'
		oCtrl.ShowZeroValues = true
		msgbox "Zero( = 0 ) 表示",0,"ClacView"
End Sub

Sub CalcView()
	Dim oDoc as Object
	Dim oSheet as Object, oCell as Object
	Dim oCmt as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		' Annotation Object 作成
		oCmt = oCell.getAnnotation()
		' 新規Commentの挿入
		oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの挿入")
		'
		' Commentの非表示
		oCmt.setIsVisible( false )
		msgbox "Comment非表示",0,"ClacView"
		'
		' Commentの表示
		oCmt.setIsVisible( true )
		msgbox "Comment表示",0,"ClacView"
End Sub

Sub DocUnoCalc()
	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")
		' A1 Cellへ
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		 ' Commnet常時表示
		 	oProp(0).Name = "NoteVisible"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:NoteVisible", "", 0, oProp())
		msgbox "Commnet常時表示",0,"Comment"
		' Commnet通常表示
		 	oProp(0).Name = "NoteVisible"
			oProp(0).Value = ｆａｌｓｅ
		oDispatcher.executeDispatch(oFrame, ".uno:NoteVisible", "", 0, oProp())
		msgbox "Commnet通常表示",0,"Comment"
End Sub

Sub CalcView()
	Dim oDoc as Object, oCtrl as Object
	Dim oSheet as Object, oCell as Object
	Dim oCmt as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		' Annotation Object 作成
		oCmt = oCell.getAnnotation()
		' 新規Commentの挿入
		oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの表示")
		'
		' Comment Markの非表示
		oCtrl = oDoc.getCurrentController()
		oCtrl.ShowNotes = false
		msgbox "Comment Mark非表示" & Chr$(10) & "(右上角の■ 無し",0,"ClacView"
		'
		' Commentの表示
		oCtrl.ShowNotes = true
		msgbox "Comment Mark非表示" & Chr$(10) & "右上角の■有り",0,"ClacView"
End Sub

Sub CalcView()
	Dim oDoc as Object
	Dim oSnapRst as Boolean
	Dim oRstIsVisi as Boolean
	Dim oRstX as Long, oRstY as Long
	Dim oRstSubX as Long, oRstSubY as Long
	Dim oSynRst as Boolean
	 oDoc = ThisComponent
	 '
	 oSpdSht = oDoc.createInstance("com.sun.star.sheet.DocumentSettings")
	 ' こちらでも OK
	 Rem oSpdSht = oDoc.createInstance("com.sun.star.comp.SpreadsheetSettings")
	 	'
		' オプション → Calc → グリッド線 / Readonly 
		' 「 グリッド線で位置合わせ 」設定取得
		oSnapRst = oSpdSht.IsSnapToRaster
		' 「 グリッド線の表示 」設定取得
		oRstIsVisi = oSpdSht.RasterIsVisible
		' 「 解像度 」
		oRstX = oSpdSht.RasterResolutionX
		oRstY = oSpdSht.RasterResolutionY
		' 「 サブ目盛 」
		oRstSubX = oSpdSht.RasterSubdivisionX
		oRstSubY = oSpdSht.RasterSubdivisionY
		' 「 軸を同期させる 」
		oSynRst = oSpdSht.IsRasterAxisSynchronized
		'
		oDisp = "[ Option : Grid設定取得 ]" & Chr$(10) & "「 グリッド線で位置合わせ 」 = " & oSnapRst & Chr$(10) & _
					 " 「 グリッド線の表示 」 = " & oRstIsVisi & Chr$(10) & _
					 "解像度 / 「横に」 =  " & oRstX & Chr$(10) & "解像度 / 「縦に」 =  " & oRstY & Chr$(10) & _
					 "サブ目盛 / 「横に」 =  " & oRstSubX & Chr$(10) & "サブ目盛 / 「縦に」 =  " & oRstSubY & Chr$(10) & _
					 "「 軸を同期させる 」 = " & oSynRst
		'
		msgbox oDisp, 0, "Option設定"
End Sub
'
' [ Note ]
' サブ目盛 の取得値は表示される値から -1
' 4 ならば 取得値は 3

Document Setting

Sub CalcSpellCheck()
	Dim oDoc as Object
		oDoc = ThisComponent
		oDoc.SpellOnline = True		' False : OFF
		msgbox "Auto Spell Check / ON",0,"LO4.2.4"
End Sub
'
' [ Note ]
' Current CellのSpell Checkは General ⇒ Locale を参照 

Sub CalcDocSet()
	Dim oDoc as Object
	Dim oDefTabStop as Integer
	Dim oDisp as String
		oDoc = ThisComponent
		oDefTabStop = oDoc.DefaultTabStop
		oDisp = "Defult Tab Stop" & Chr$(10) & " = " & oDefTabStop
		msgbox oDisp, 0, "LO4.2.4"
End Sub
'
' [ Note ]
' Refer : Microsoft / TechNet : DefaultTabStop Class

Data Pilot

Sub oCreateDataPilotSource()
	Dim oName
	Dim oItem()
	Dim oTeam()
	Dim oCity()
	Dim oInvCompany
	Dim ovalSheets
	Dim oSheet
	Dim i as Integer
	Dim nItem as Integer
	Dim nCity as integer
	Dim nTeam as Integer
	Dim d2007 as Double
	Dim d2008 as Double
	Dim d2009 as Double
		oName = "DataPilot"
		ovalSheets = ThisComponent.Sheets
		If NOT ovalSheets.hasByName(oName) then
			ovalSheets.insertNewByName(oName, ovalSheets.getCount())		' ← 最後尾にsheetを追加
		End If
		oSheet = ovalSheets.getByName(oName)
			
		oItem = Array("Books","Candy","Pens")
		oTeam = Array("Jean","Bob","Ilsub","Alan","Chelle","Andy")
		oCity = Array("Michigan","Ohio","Kentucky")
		
		oData = DimArray((UBound(oItem)+1) * (UBound(oTeam)+1))
		oData(0) = Array("Item",  "State",  "Team",  "2007", "2008", "2009")
		Dim a()
					a = oData(0,0)
					oDisp = oDisp & a(0) & Chr$(9) & a(1) & Chr$(9) & a(2) & Chr$(9) & a(3) & Chr$(9) & a(4) & Chr$(9) & a(5)
					oDisp= oDisp & Chr$(10)
		i=0
		for nTeam = 0 to UBound(oTeam)
			for nItem = 0 to UBound(oItem)
			'print UBound(oItem)
				i=i+1
				d2007 =	1000.0 + 2000.0* Rnd
				d2008 =	1500.0 + 2000.0* Rnd
				d2009 =	2000.0 + 2000.0* Rnd 
				oData(i) = Array(oItem(nItem), oCity(nIem),  oTeam(nTeam), Int(d2007),  Int(d2008), Int(d2009))
					a = oData(i)
					oDisp = oDisp & a(0) & Chr$(9) & a(1) & Chr$(9) & a(2) & Chr$(9) & a(3) & Chr$(9) & a(4) & Chr$(9) & a(5)
					oDisp= oDisp & Chr$(10)
			next nItem
		next nTeam
		msgbox(oDisp)
		oRange = oSheet.getCellRangeByName("A1:F" & (UBound(oData)+1))
		oRange.setDataArray(oData)
	'
		Dim oFormats
		Dim oTempRange
			oTempRange = oSheet.getCellRangeByName("D2:F" & (UBound(oData)+1))
			oFormats = ThisComponent.NumberFormats
		Dim oLocale as new com.sun.star.lang.Locale
			oTempRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.CURRENCY, oLocale)
			oTempRange = oSheet.getCellRangeByName("A1:F1")
			oTempRange.CellBackColor = RGB(200,200,200)
			oTempRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
End Sub

Sub oCreateDataPilotTable
	Dim oSheet
	Dim oRange
	Dim oRangeAddress
	Dim oTables
	Dim oTDescriptor
	Dim oAllFields
	Dim oField
	Dim oCellAddress as new com.sun.star.table.CellAddress
		Randomize(37)
		oRange = oDataPilotSource("Pilot")
	'
		oRangeAddress = oRange.getRangeAddress()
			oCellAddress.Sheet = oRangeAddress.Sheet
			oCellAddress.Column = oRangeAddress.StartColumn
			oCellAddress.Row = oRangeAddress.EndRow + 2
			
		oSheet = ThisComponent.Sheets.getByName("Pilot")
		oTables = oSheet.getDataPilotTables()
	' Step1	Create the descriptor
		oTDescriptor = oTables.createDataPilotDescriptor()
	' Sep2	Set the Source Range
		oTdescriptor.setSourceRange(oRangeAddress)
	' Step3	Set the fileds
		oAllFields = oTDescriptor.getDataPilotFields()
'Define to be the Column0 as a row item
	oField = oAllFields.getByIndex(0)
	oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
'Define to be the Column1 as a Column item
	oField = oAllFields.getByIndex(1)
	oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN
'Define to be Created a sum in the data for the Column3
	oField = oAllFields.getByIndex(3)
	oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
	oField.Function = com.sun.star.sheet.GeneralFunction.SUM
'
	oTables.insertNewByName("MyFirstDataPilot", oCellAddress, oTDescriptor)
		
End Sub
'
'[ Function1 ]
Function oDataPilotSource(oName) as Varient
	Dim oItem()
	Dim oTeam()
	Dim oCity()
	Dim oInvCompany
	Dim ovalSheets
	Dim oSheet
	Dim i as Integer
	Dim nItem as Integer
	Dim nCity as integer
	Dim nTeam as Integer
	Dim d2007 as Double
	Dim d2008 as Double
	Dim d2009 as Double
		ovalSheets = ThisComponent.Sheets
		If NOT ovalSheets.hasByName(oName) then
			ovalSheets.insertNewByName(oName, ovalSheets.getCount())		' ← 最後尾にsheetを追加
		End If
		oSheet = ovalSheets.getByName(oName)
			
		oItem = Array("Books","Candy","Pens")
		oTeam = Array("Jean","Bob","Ilsub","Alan","Chelle","Andy")
		oCity = Array("Michigan","Ohio","Kentucky")
		
		oData = DimArray((UBound(oItem)+1) * (UBound(oTeam)+1))
		oData(0) = Array("Item",  "State",  "Team",  "2007", "2008", "2009")
		dim a()
					a = oData(0,0)
					oDisp = oDisp & a(0) & Chr$(9) & a(1) & Chr$(9) & a(2) & Chr$(9) & a(3) & Chr$(9) & a(4) & Chr$(9) & a(5)
					oDisp= oDisp & Chr$(10)
		i=0
		for nTeam = 0 to UBound(oTeam)
			for nItem = 0 to UBound(oItem)
				i=i+1
				d2007 =	1000.0 + 2000.0* Rnd
				d2008 =	1500.0 + 2000.0* Rnd
				d2009 =	2000.0 + 2000.0* Rnd 
				oData(i) = Array(oItem(nItem), oCity(nIem),  oTeam(nTeam), Int(d2007),  Int(d2008), Int(d2009))
			next nItem
		next nTeam
		
		oRange = oSheet.getCellRangeByName("A1:F" & (UBound(oData)+1))
		oRange.setDataArray(oData)
	'
		Dim oFormats
		Dim oTempRange
			oTempRange = oSheet.getCellRangeByName("D2:F" & (UBound(oData)+1))
			oFormats = ThisComponent.NumberFormats
		Dim oLocale as new com.sun.star.lang.Locale
			oTempRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.CURRENCY, oLocale)
			oTempRange = oSheet.getCellRangeByName("A1:F1")
			oTempRange.CellBackColor = RGB(200,200,200)
			oTempRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
		'Return
			oDataPilotSource = oRange
End Function

Sub oRemoveDataPilot
	Dim oSheet
		oSheet = ThisComponent.Sheets.getByName("Pilot")
		oTables = oSheet.getDataPilotTables()
		oRDescriptor = oTables.removeByName("MyFirstDataPilot")
End Sub

Sub GeneralMenu()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch( oFrame, ".uno:DataDataPilotRun", "", 0, Array())
		msgbox "Success"
End Sub

GoalSeek

Sub oGoakSeek
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oTCell as Object
	Dim oRCell as Object
	Dim oGoal as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oTCell = oSheet.getCellByPosition(1,0)
		oTCell.Value = 1
		'
		oRCell = oSheet.getCellByPosition(0,0)
		oRCell.Formula= "=10*B1"
	'GoalSeek
		oGoal = oDoc.seekGoal(oRCell.CellAddress, oTCell.CellAddress, "100")	
	'Display
		msgbox("Result = " & oGoal.Result & Chr$(10) & _
				"The result changed by " & oGoal.Divergence & " in the last iteration", 0, "Goal Seek")			
End Sub

Sub UnoGoakSeek()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    	oDoc = ThisComponent
    	oCtrl = oDoc.getCurrentController()
    	oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:GoalSeekDialog", "", 0, Array())
End Sub

Scenario

Sub CalcScenario()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oSnr as Object
	Dim oCellRange as Object, oCellRangeAddr as Object
	Dim oSnrName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' 前準備
		oSheet.getCellByPosition(0,0).String = "定価"
		oSheet.getCellByPosition(0,1).String = "割引率"
		oSheet.getCellByPosition(0,2).String = "税金"
		oSheet.getCellByPosition(0,3).String = "送料"
		oSheet.getCellByPosition(0,4).String = "購入価格"
		' 
		oSheet.getCellByPosition(1,0).Value = 10000
		oSheet.getCellByPosition(1,1).Value = 0.1
		oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
		oSheet.getCellByPosition(1,3).Value = 500
		oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
		' 
		' Scenario作成 ( シナリオ1 )
		oSnrName = "Scenario_1"
		oSnr = oSheet.getScenarios()
		oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
		oCellRangeAddr = oCellRange.getRangeAddress()
		oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
		oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を作成しました。"
		msgbox(oDisp, 0, "Scenario")
		'
		' Scenarioの削除
		oSnr.removeByName(oSnrName)
		oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を削除しました。"
		msgbox(oDisp , 0,"Scenario")
End Sub
'
' [ 参考 ]
' シナリオの作成方法はようこそ Cafi Net カフィネットへのBlog Pageに詳しく記されています。

Sub CalcScenario()
	Dim oDoc As Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oPropS(2) as new com.sun.star.beans.PropertyValue
	Dim oSnr as Object
	Dim oSnrName as String, oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' 前準備
		oSheet.getCellByPosition(0,0).String = "定価"
		oSheet.getCellByPosition(0,1).String = "割引率"
		oSheet.getCellByPosition(0,2).String = "税金"
		oSheet.getCellByPosition(0,3).String = "送料"
		oSheet.getCellByPosition(0,4).String = "購入価格"
		' 
		oSheet.getCellByPosition(1,0).Value = 40000
		oSheet.getCellByPosition(1,1).Value = 0.2
		oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
		oSheet.getCellByPosition(1,3).Value = 500
		oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
		' 
		' Select Area
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "B1:B5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		' Scenario作成 ( シナリオ1 )
		oSnrName = "CalcScenario01"
			oPropS(0).Name = "Name"
			oPropS(0).Value = oSnrName
			oPropS(1).Name = "Comment"
			oPropS(1).Value = "Scenario1のCommentです"
		oDispatcher.executeDispatch(oFrame, ".uno:ScenarioManager", "", 0, oPropS())
		'
		' 確認の為、Navigator表示
			oProp(0).Name = "Navigator"
			oProp(0).Value = True
		oDispatcher.executeDispatch(oFrame, ".uno:Navigator", "", 0, oProp())
		' Scenarioが作成されたかCheck
		oSnr = oSheet.getScenarios()
		if oSnr.hasByName(oSnrName) = True then
			oDisp = "Scenario名 : " & oSnrName & Chr$(10) & "を作成しました"
			msgbox(oDisp, 0, "Scenario作成")
		else
			oDisp = "Scenario名 : " & oSnrName & Chr$(10) & "の作成に失敗しました"
			msgbox(oDisp, 0, "Scenario作成")
			Exit Sub
		end if
		'
		' Scenariooの削除
			oProp(0).Name = "ScenarioName"
			oProp(0).Value = oSnrName
		oDispatcher.executeDispatch(oFrame, ".uno:DeleteScenario", "", 0, oProp())
		if oSnr.hasByName(oSnrName) = False then
			oDisp = "Scenario名 : " & oSnrName & Chr$(10) & "を削除しました"
		else
			oDisp = "Scenario名 : " & oSnrName & Chr$(10) & "の削除に失敗しました"
		end if
		msgbox(oDisp, 0, "Scenario削除")
End Sub
'
' [ Note ]
' ScenarioのCommentは、Scenarioを選択しないとNavigatorに表示されない。

Sub CalcScenario()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oSnr as Object
	Dim oCellRange as Object, oCellRangeAddr as Object
	Dim oSnrName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' 前準備
		oSheet.getCellByPosition(0,0).String = "定価"
		oSheet.getCellByPosition(0,1).String = "割引率"
		oSheet.getCellByPosition(0,2).String = "税金"
		oSheet.getCellByPosition(0,3).String = "送料"
		oSheet.getCellByPosition(0,4).String = "購入価格"
		' 
		oSheet.getCellByPosition(1,0).Value = 10000
		oSheet.getCellByPosition(1,1).Value = 0.1
		oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
		oSheet.getCellByPosition(1,3).Value = 500
		oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
		' 
		' Scenario作成 ( シナリオ1 )
		oSnrName = "Scenario_1"
		oSnr = oSheet.getScenarios()
		oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
		oCellRangeAddr = oCellRange.getRangeAddress()
		oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
		'
	' Scenario の各種設定
	Dim oSnrObj as Object
	Dim oSnrShow as Boolean, oSnrPct as Boolean, oSnrPrtBrdr as Boolean, oSnrCyBk as Boolean, oSnrCpStyle as Boolean, oSnrCpFormula as Boolean
		oSnrObj = oSnr.getByName(oSnrName)
		if oSnrObj.IsActive = true then
			oSnrObj.BorderColor = RGB(0,255,0)			' 色によっては 削除時にError が発生( 理由不明 )
			oSnrPct = oSnrObj.Protected
			oSnrShow = oSnrObj.ShowBorder
			oSnrPrtBrdr = oSnrObj.PrintBorder
			oSnrCyBk = oSnrObj.CopyBack
			oSnrCpStyle = oSnrObj.CopyStyles
			oSnrCpFormula = oSnrObj.CopyFormulas
			oDisp = "oSnrPct = " & oSnrPct & Chr$(10) & "oSnrShow = " & oSnrShow & Chr$(10) & _
						"oSnrPrtBrdr = " & oSnrPrtBrdr & Chr$(10) & "oSnrCyBk = " & oSnrCyBk & Chr$(10) & _
						"oSnrCpStyle = " & oSnrCpStyle & Chr$(10) & "oSnrCpFormula = " & oSnrCpFormula
		end if
		msgbox(oDisp, 0, "Scenario")			' msgbox を移動させると 削除時に Errorが発生
		'
		' Scenarioの削除
		oSnrObj.Protected = false
		oSnr.removeByName(oSnrName)
		oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を削除しました。"
		msgbox(oDisp , 0,"Scenario")
End Sub

Sub CalcScenario()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oSnr as Object
	Dim oCellRange as Object, oCellRangeAddr as Object
	Dim oSnrName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' 前準備
		oSheet.getCellByPosition(0,0).String = "定価"
		oSheet.getCellByPosition(0,1).String = "割引率"
		oSheet.getCellByPosition(0,2).String = "税金"
		oSheet.getCellByPosition(0,3).String = "送料"
		oSheet.getCellByPosition(0,4).String = "購入価格"
		' 
		oSheet.getCellByPosition(1,0).Value = 10000
		oSheet.getCellByPosition(1,1).Value = 0.1
		oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
		oSheet.getCellByPosition(1,3).Value = 500
		oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
		' 
		' Scenario作成 ( シナリオ1 )
		oSnrName = "Scenario_1"
		oSnr = oSheet.getScenarios()
		oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
		oCellRangeAddr = oCellRange.getRangeAddress()
		oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "これはシナリオのコメント")
		'
	' Scenario のComment取得
	Dim oSnrCmt as String
		oSnrObj = oSnr.getByName(oSnrName)
		oSnrCmt = oSnrObj.getScenarioComment()
		oDisp = "[ Comment ]" & Chr$(10) & oSnrCmt
		'
		' Commentの変更
		oSnrObj.setScenarioComment("変更したコメント")
		oSnrCmt = oSnrObj.getScenarioComment()
		oDisp = oDisp & Chr$(10) & Chr$(9) & "↓" & Chr$(10) & oSnrCmt
		msgbox(oDisp, 0, "Scenario")
		'
		' Scenarioの削除
		oSnrObj.Protected = false
		oSnr.removeByName(oSnrName)			'たまに、 原因不明の Error が生じる事がある。
		oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を削除しました。"
		msgbox(oDisp , 0,"Scenario")
End Sub

Sub CalcScenario()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oSnr as Object
	Dim oCellRange as Object, oCellRangeAddr as Object
	Dim oSnrName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' 前準備
		oSheet.getCellByPosition(0,0).String = "定価"
		oSheet.getCellByPosition(0,1).String = "割引率"
		oSheet.getCellByPosition(0,2).String = "税金"
		oSheet.getCellByPosition(0,3).String = "送料"
		oSheet.getCellByPosition(0,4).String = "購入価格"
		' 
		oSheet.getCellByPosition(1,0).Value = 10000
		oSheet.getCellByPosition(1,1).Value = 0.1
		oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
		oSheet.getCellByPosition(1,3).Value = 500
		oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
		' 
		' Scenario作成 ( シナリオ1 )
		oSnrName = "Scenario_1"
		oSnr = oSheet.getScenarios()
		oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
		oCellRangeAddr = oCellRange.getRangeAddress()
		oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
		'
		oDisp = "Scenarioの有無" & Chr$(10) & " → " & oSnr.hasElements()
		msgbox(oDisp, 0, "Scenario作成")
		'
		' Scenarioの削除
		oSnr.removeByName(oSnrName)
		oDisp = "Scenarioの有無" & Chr$(10) & " → " & oSnr.hasElements()
		msgbox(oDisp , 0,"Scenario削除")
End Sub

Sub CalcScenario()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oSnr as Object
	Dim oCellRange as Object, oCellRangeAddr as Object
	Dim oSnrName as String, oSnrName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' 前準備
		oSheet.getCellByPosition(0,0).String = "定価"
		oSheet.getCellByPosition(0,1).String = "割引率"
		oSheet.getCellByPosition(0,2).String = "税金"
		oSheet.getCellByPosition(0,3).String = "送料"
		oSheet.getCellByPosition(0,4).String = "購入価格"
		' 
		oSheet.getCellByPosition(1,0).Value = 10000
		oSheet.getCellByPosition(1,1).Value = 0.1
		oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
		oSheet.getCellByPosition(1,3).Value = 500
		oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
		' 
		' Scenario作成 ( シナリオ1 )
		oSnrName = "Scenario_1"
		oSnr = oSheet.getScenarios()
		oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
		oCellRangeAddr = oCellRange.getRangeAddress()
		oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
		'
		oSnrName2 = "Scenario_2"
		oDisp = "[ Scenarioの有無 ]" & Chr$(10) & oSnrName & " → " & oSnr.hasByName(oSnrName) & Chr$(10) & _
					oSnrName2 & " → " & oSnr.hasByName(oSnrName2)
		msgbox(oDisp, 0, "Scenario作成")
		'
		' Scenarioの削除
		oSnr.removeByName(oSnrName)			' 時々Error発生
		oDisp = "[ Scenarioの有無 ]" & Chr$(10) & oSnrName & " → " & oSnr.hasByName(oSnrName) & Chr$(10) & _
					oSnrName2 & " → " & oSnr.hasByName(oSnrName2)
		msgbox(oDisp , 0,"Scenario削除")
End Sub

Graph Chart作成

Sub CalcChart2()
	Dim oDoc as Object, oSheet as Object
	Dim oCellA as Object, oCellB as Object
	Dim oRange As Object
	Dim oCharts As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(0) As New com.sun.star.table.CellRangeAddress
		oDoc=ThisComponent
		oShtIndex = 0
		oSheet = oDoc.getSheets().getByIndex(oShtIndex)
		for i = 0 to 4
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellA.Value = i + 1
			oCellB.Formula = "=A" & (i + 1) & "*10"
		next i
		' Set Data Range
		oRange = oSheet.getCellRangeByName("A1:B5").getRangeAddress()
		' Set Sheet Index
		oRangeAddress(0).sheet = oRange.Sheet
		' Set X axis Data
		oRangeAddress(0).StartColumn = oRange.StartColumn
		oRangeAddress(0).EndColumn = oRange.EndColumn
		' Set Y axis Data
		oRangeAddress(0).StartRow = oRange.StartRow
		oRangeAddress(0).EndRow = oRange.EndRow
		'
		' Set Size & Position of Chart
		with oRect
			.Height = 5000	'Unit : 1/100mm
			.Width = 6000		'Unit : 1/100mm
			.x = 1800  			' Unit : 1/100mm
			.y = 100				' Unit : 1/100mm
		end With
		'
		' 同名Chart削除
		oTitle="CalcChart2"
		oCharts=oSheet.getCharts()
  		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
		'
		' Add new Chart
		oCharts.addNewByName(oTitle, oRect, oRangeAddress, False, False)
		'
		' Get newly created chart
		oChart = oCharts.getByName(oTitle).getEmbeddedObject()
		'
		msgbox "Success",0,"LO4.3.2"
End Sub

Sub CalcSimpleChart()
	Dim oDoc as Object, oSheet as Object
	Dim oCellA as Object, oCellB as Object
	Dim oRange As Object
	Dim oCharts As Object
	Dim oChart_Line As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(0) As New com.sun.star.table.CellRangeAddress
		oDoc=ThisComponent
		oShtIndex = 0
		oSheet = oDoc.getSheets().getByIndex(oShtIndex)
		for i = 0 to 4
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellA.Value = i + 1
			oCellB.Formula = "=A" & (i + 1) & "*10"
		next i
	' Set Data Range
		oRange = oSheet.getCellRangeByName("A1:B5").getRangeAddress()
	' Set Sheet Index
		oRangeAddress(0).sheet = oRange.Sheet
	' Set X axis Data
		oRangeAddress(0).StartColumn = oRange.StartColumn
		oRangeAddress(0).EndColumn = oRange.EndColumn		' AOO4.1.1 ⇒  = 1 (oRange.EndColumn = 1024)
	' Set Y axis Data
		oRangeAddress(0).StartRow = oRange.StartRow
		oRangeAddress(0).EndRow = oRange.EndRow			' AOO4.1.1 ⇒  = 4 (oRange.EndColumn = 1048676)
	' Cahrt Object Size
		oRect.Height = 5000	'Unit : 1/100mm
		oRect.Width = 6000		'Unit : 1/100mm
		oRect.x = 1800  			' Unit : 1/100mm
		oRect.y = 100				' Unit : 1/100mm
	' 同名のChartは消す
		oTitle="Simple Chart"		' AOO4.1.1 ⇒ oTitle="SimpleChart" (Blank : NG) 
		oCharts=oSheet.getCharts()
		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
	' Draw Chart
		oCharts.addNewByName(oTitle,oRect,oRangeAddress(),True,True)
	' 指定TitleのChartを取得
		oChart_Line = oCharts.getByName(oTitle).embeddedObject
		oChart_Line.HasMainTitle = True
		oChart_Line.Title.String = oTitle
	'軸Title表示
		oChart_Line.diagram.HasXAxisTitle = true
		oChart_Line.diagram.XAxisTitle.String = "Data"
		oChart_Line.diagram.HasYAxisTitle = true
		oChart_Line.diagram.YAxisTitle.String = "Number of Cases"
	'X目盛の傾きset
		oChart_Line.diagram.XAxis.TextBreak = false
		oChart_Line.diagram.XAxis.TextRotation = 2700 'Unit: 1/100th of degree
	' Chartの種類を変更
		oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.XYkDiagram")		'棒グラフ(="BarDiagram")
		msgbox "Success"
End Sub
'
' [ Note ]
' Chartの種類
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.LineDiagram")	'折れ線グラフ
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.AreaDiagram")	'折れ線の下範囲に色付きグラフ
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.BarDiagram")		'棒グラフ(Default)
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.DonutDiagram")	'円グラフ(中心空洞)
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.NetDiagram")		'円折れ線グラフ
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.PieDiagram")		'円グラフ
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.StackableDiagram")	'棒グラフ(="BarDiagram")
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.StockDiagram")		'ローソク線
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.BubbleDiagram")	' since OOo 3.2
'	oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.FilledNetDiagram")	' since OOo 3.2

Sub CalcSimpleChart()
	Dim oDoc as Object, oSheet as Object
	Dim oCellA as Object, oCellB as Object, oCellC as Object
	Dim oCharts As Object
	Dim oChart_Line As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(2) As New com.sun.star.table.CellRangeAddress
		oDoc=ThisComponent
		oShtIndex = 0
		oSheet = oDoc.getSheets().getByIndex(oShtIndex)
		for i = 0 to 4
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellC = oSheet.getCellByPosition(3, i )
			oCellA.Value = i + 1
			oCellB.Formula = "=A" & (i + 1) & "*10"
			oCellC.Formula = "=A" & (i + 1) & "*30"
		next i
	' Set Data Range / X Axis : oRangeAddress(0)
		for i = 0 to 2
			if i = 2 then
				n = i +1
			else
				n = i
			end if
			oRangeAddress(i).sheet = oShtIndex
			oRangeAddress(i).StartColumn = n
			oRangeAddress(i).EndColumn = n
			oRangeAddress(i).StartRow = 0
			oRangeAddress(i).EndRow = 4
		next i
	' Cahrt Object Size
		oRect.Height = 5000	'Unit : 1/100mm
		oRect.Width = 6000		'Unit : 1/100mm
		oRect.x = 2800  			' Unit : 1/100mm
		oRect.y = 100				' Unit : 1/100mm
	' 同名のChartは消す
		oTitle="Simple Chart"		' AOO4.1.1 ⇒ oTitle="SimpleChart" (Blank : NG) 
		oCharts=oSheet.getCharts()
		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
	' Draw Chart
		oCharts.addNewByName(oTitle,oRect,oRangeAddress(),True,True)
	' 指定TitleのChartを取得
		oChart_Line = oCharts.getByName(oTitle).embeddedObject
		oChart_Line.HasMainTitle = True
		oChart_Line.Title.String = oTitle
		oChart_Line.Subtitle.String = "(SubTitle)"
	' 汎用の表示
		oChart_Line.HasLegend = true		' Diagramが1つの時は無くても表示 / AOOは必須
	'軸Title表示
		oChart_Line.diagram.HasXAxisTitle = true
		oChart_Line.diagram.XAxisTitle.String = "Data"
		oChart_Line.diagram.HasYAxisTitle = true
		oChart_Line.diagram.YAxisTitle.String = "Number of Cases"
	'X目盛の傾きset
		oChart_Line.diagram.XAxis.TextBreak = false
		oChart_Line.diagram.XAxis.TextRotation = 2700 'Unit: 1/100th of degree
	' Chartの種類を変更
		oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.BarDiagram")
		msgbox "Success",0,"LO4.3.2"
End Sub

Sub SimpleChartMacro()
	Dim oDoc as Object, oSheet as Object, oRange As Object
	Dim oCharts As Object
	Dim oChart_Line As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(0) As New com.sun.star.table.CellRangeAddress
		oDoc=ThisComponent
		oTitle="Simple Chart(2)"
		oRect.Height = 5000  'Unit : 1/100mm
		oRect.Width = 6000  'Unit : 1/100mm
		oRect.x = 1800  'Unit : 1/100mm
		oRect.y = 100  'Unit : 1/100mm
		oRange=oDoc.getCurrentSelection.getRangeAddress
		oSheet=oDoc.CurrentSelection.getSpreadsheet
		oCharts=oSheet.Charts
		msgbox oRange.Sheet
	' Set Sheet Name
		oRangeAddress(0).sheet = oRange.Sheet
	' Set X axis Data
		oRangeAddress(0).StartColumn = oRange.StartColumn
		oRangeAddress(0).EndColumn = oRange.EndColumn
	' Set Y axis Data
		oRangeAddress(0).StartRow = oRange.StartRow
		oRangeAddress(0).EndRow = oRange.EndRow	
	'同名のChartは消す
		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
	'Draw Chart
		oCharts.addNewByName(oTitle,oRect,oRangeAddress(),True,True)
	'Chart Title表示
		oChart_Line=oCharts.getByName(oTitle).embeddedObject
		oChart_Line.HasMainTitle = True
		oChart_Line.Title.String = oTitle
	'軸Title表示
		oChart_Line.diagram.HasXAxisTitle = true
		oChart_Line.diagram.XAxisTitle.String = "Data"
		oChart_Line.diagram.HasYAxisTitle = true
		oChart_Line.diagram.YAxisTitle.String = "Number"
	'X目盛の傾きset
		oChart_Line.diagram.XAxis.TextBreak = false
		oChart_Line.diagram.XAxis.TextRotation =2700 'Unit: 1/100th of degree
	'Chartの種類を変更
		oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.LineDiagram")	
	msgbox "Success( Data範囲を事前選択 )"
End Sub

Sub CalcChart2()
	Dim oDoc as Object, oSheet as Object
	Dim oCellA as Object, oCellB as Object
	Dim oRange As Object
	Dim oCharts As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(0) As New com.sun.star.table.CellRangeAddress
	Dim oRowNum as Integer
	Dim oCellRng as String
		oDoc=ThisComponent
		oShtIndex = 0
		oSheet = oDoc.getSheets().getByIndex(oShtIndex)
		oRowNum = 10
		for i = 0 to oRowNum
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellA.Value = -5 + i 
			oCellB.Formula = "=A" & (i + 1) & "^2"
		next i
		' Set Data Range
		oCellRng = "A1:B" & CStr(oRowNum + 1)
		oRange = oSheet.getCellRangeByName(oCellRng).getRangeAddress()
		' Set Sheet Index
		oRangeAddress(0).sheet = oRange.Sheet
		' Set X axis Data
		oRangeAddress(0).StartColumn = oRange.StartColumn
		oRangeAddress(0).EndColumn = oRange.EndColumn
		' Set Y axis Data
		oRangeAddress(0).StartRow = oRange.StartRow
		oRangeAddress(0).EndRow = oRange.EndRow
		'
		' Set Size & Position of Chart
		with oRect
			.Height = 5000	'Unit : 1/100mm
			.Width = 6000		'Unit : 1/100mm
			.x = 1800  			' Unit : 1/100mm
			.y = 100				' Unit : 1/100mm
		end With
		'
		' 同名Chart削除
		oTitle="CalcChart2"
		oCharts=oSheet.getCharts()
  		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
		'
		' Add new Chart
		oCharts.addNewByName(oTitle, oRect, oRangeAddress, False, False)
		'
		' Get newly created chart
		oChart = oCharts.getByName(oTitle).getEmbeddedObject()
		'
		' Diagram of the css.chart2
		oDiagram = oChart.getFirstDiagram()
		' Create template and set to it
		oChartTypeManager = oChart.getChartTypeManager()
		oChartTypeTemplate = oChartTypeManager.createInstance("com.sun.star.chart2.template.ScatterLineSymbol")
		oChartTypeTemplate.changeDiagram(oDiagram)
		'
		msgbox "Success",0,"LO4.3.2"
End Sub
'
' [ Note ]
' Chart Templateを用いたGraph作成の詳細はN->N->Nを参照。
' // 棒グラフ //
' com.sun.star.chart2.template.Bar	横
' com.sun.star.chart2.template.StackedBar	横積み上げ
' com.sun.star.chart2.template.PercentStackedBar	横積み上げパーセント
' com.sun.star.chart2.template.ThreeDBarDeep	3D 横奥行きあり
' com.sun.star.chart2.template.ThreeDBarFlat	3D 横奥行きなし
' com.sun.star.chart2.template.StackedThreeDBarFlat	3D 横積み上げ
' com.sun.star.chart2.template.PercentStackedThreeDBarFlat	3D 横積み上げパーセント
' com.sun.star.chart2.template.Column	縦
' com.sun.star.chart2.template.StackedColumn	縦積み上げ
' com.sun.star.chart2.template.PercentStackedColumn	縦積み上げパーセント
' com.sun.star.chart2.template.ThreeDColumnDeep	3D 縦奥行きあり
' com.sun.star.chart2.template.ThreeDColumnFlat	3D 縦奥行きなし
' com.sun.star.chart2.template.PercentStackedThreeDColumnFlat	3D 縦積み上げ
' com.sun.star.chart2.template.StackedThreeDColumnFlat	3D 縦積み上げパーセント
'
' // 円グラフ //
' com.sun.star.chart2.template.Pie	扇型
' com.sun.star.chart2.template.PieAllExploded	扇型分解
' com.sun.star.chart2.template.ThreeDPie	3D 扇型
' com.sun.star.chart2.template.ThreeDPieAllExploded	3D 扇型分解
' com.sun.star.chart2.template.Donut	ドーナツ
' com.sun.star.chart2.template.DonutAllExploded	ドーナツ分解
' com.sun.star.chart2.template.ThreeDDonut	3D ドーナツ
' com.sun.star.chart2.template.ThreeDDonutAllExploded	3D ドーナツ分解
'
' // エリアグラフ //
' com.sun.star.chart2.template.Area	エリア
' com.sun.star.chart2.template.StackedArea	積み上げ
' com.sun.star.chart2.template.ThreeDArea	3D
' com.sun.star.chart2.template.StackedThreeDArea	3D 積み上げ
' com.sun.star.chart2.template.PercentStackedArea	積み上げパーセント
' com.sun.star.chart2.template.PercentStackedThreeDArea	3D 積み上げパーセント
'
' // 折れ線 //
' com.sun.star.chart2.template.Symbol	点
' com.sun.star.chart2.template.Line	線
' com.sun.star.chart2.template.LineSymbol	点と線
' com.sun.star.chart2.template.ThreeDLine	3D 線
' com.sun.star.chart2.template.ThreeDLineDeep	3D 線奥行きあり
' com.sun.star.chart2.template.StackedSymbol	点積み上げ
' com.sun.star.chart2.template.StackedLine	線積み上げ
' com.sun.star.chart2.template.StackedLineSymbol	点と線積み上げ
' com.sun.star.chart2.template.StackedThreeDLine	3D 線積み上げ
' com.sun.star.chart2.template.PercentStackedSymbol	点積み上げパーセント
' com.sun.star.chart2.template.PercentStackedLine	線積み上げパーセント
' com.sun.star.chart2.template.PercentStackedLineSymbol	点と線積み上げパーセント
' com.sun.star.chart2.template.PercentStackedThreeDLine	3D 線積み上げパーセント
'
' // 散布図 //
' com.sun.star.chart2.template.ScatterLine	ラインのみ
' com.sun.star.chart2.template.ScatterLineSymbol	ラインとデータ点
' com.sun.star.chart2.template.ScatterSymbol	データ点
' com.sun.star.chart2.template.ThreeDScatter	3D
'
' // レーダー網 //
' com.sun.star.chart2.template.Net	点と線
' com.sun.star.chart2.template.NetLine	線
' com.sun.star.chart2.template.NetSymbol	点
' com.sun.star.chart2.template.StackedNet	積み上げ点と線
' com.sun.star.chart2.template.StackedNetLine	積み上げ線
' com.sun.star.chart2.template.StackedNetSymbol	積み上げ点
' com.sun.star.chart2.template.PercentStackedNet	点と線積み上げパーセント
' com.sun.star.chart2.template.PercentStackedNetLine	線積み上げパーセント
' com.sun.star.chart2.template.PercentStackedNetSymbol	点積み上げパーセント
' com.sun.star.chart2.template.FilledNet	3.2
' com.sun.star.chart2.template.PercentStackedFilledNet	3.2
' com.sun.star.chart2.template.StackedFilledNet	3.2
'
' // ストックチャート //
' com.sun.star.chart2.template.StockLowHighClose
' com.sun.star.chart2.template.StockOpenLowHighClose
' com.sun.star.chart2.template.StockVolumeLowHighClose
' com.sun.star.chart2.template.StockVolumeOpenLowHighClose
'
' // バブルチャート //
' com.sun.star.chart2.template.Bubble

Sub CalcGraph()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:InsertObjectChart", "", 0, Array())
		msgbox "Success"
End Sub

Sub CalcGraph()
	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:DrawChart", "", 0, Array())
		msgbox "Success"
End Sub

Sub CalcSimpleChart()
	Dim oDoc as Object, oSheet as Object
	Dim oCellA as Object, oCellB as Object
	Dim oRange As Object
	Dim oCharts As Object
	Dim oChart_Line As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(0) As New com.sun.star.table.CellRangeAddress
	Dim oArea as Object, oDgn as Object
		oDoc=ThisComponent
		oShtIndex = 0
		oSheet = oDoc.getSheets().getByIndex(oShtIndex)
		for i = 0 to 4
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellA.Value = i + 1
			oCellB.Formula = "=A" & (i + 1) & "*10"
		next i
	' Set Data Range
		oRange = oSheet.getCellRangeByName("A1:B5").getRangeAddress()
	' Set Sheet Index
		oRangeAddress(0).sheet = oRange.Sheet
	' Set X axis Data
		oRangeAddress(0).StartColumn = oRange.StartColumn
		oRangeAddress(0).EndColumn = oRange.EndColumn
	' Set Y axis Data
		oRangeAddress(0).StartRow = oRange.StartRow
		oRangeAddress(0).EndRow = oRange.EndRow
	' Cahrt Object Size
		oRect.Height = 5000	'Unit : 1/100mm
		oRect.Width = 6000		'Unit : 1/100mm
		oRect.x = 1800  			' Unit : 1/100mm
		oRect.y = 100				' Unit : 1/100mm
	' Remove same name chart
		oTitle="Simple Chart"		' oTitle="Simple Chart" ⇒ LO4.2.4 : OK / AOO4.1.1 : NG(Blank : NG) 
		oCharts=oSheet.getCharts()
		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
	' Draw Chart
		oCharts.addNewByName(oTitle,oRect,oRangeAddress(),True,True)
	' Get Title Chart
		oChart_Line = oCharts.getByName(oTitle).embeddedObject
		oChart_Line.HasMainTitle = True
		oChart_Line.Title.String = oTitle
	' Show Title of Axis
		oChart_Line.diagram.HasXAxisTitle = true
		oChart_Line.diagram.XAxisTitle.String = "Data"
		oChart_Line.diagram.HasYAxisTitle = true
		oChart_Line.diagram.YAxisTitle.String = "Number of Cases"
	' Set align of scale) marks on X axis
		oChart_Line.diagram.XAxis.TextBreak = false
		oChart_Line.diagram.XAxis.TextRotation = 2700 'Unit: 1/100th of degree
	' Set propeteries of Chart Area 
		oArea = oChart_Line.getArea()
		with oArea
			.FillStyle = com.sun.star.drawing.FillStyle.SOLID
			.FillBackground = True
			.FillColor = RGB(250, 0, 255)
			.FillTransparence = "80%"
			' Line Properties ⇒ Not Responce on LO4.3..0.4  ⇒ Fixed on LO4.3.1.2 
			.LineStyle = com.sun.star.drawing.LineStyle.SOLID
			.LineWidth = 50      
			.LineColor = RGB(0,0,255)
			.LineTransparence = "50%"
		end with	
	' Diagram Area
		oDgn = oChart_Line.getDiagram().getWall()
		with oDgn
			.FillStyle = com.sun.star.drawing.FillStyle.SOLID
			.FillBackground = True
			.FillColor = RGB(255,0,0)
			.FillTransparence = "80%"
			.LineStyle = com.sun.star.drawing.FillStyle.SOLID
			.LineWidth = 50      
			.LineColor = RGB(0,255,0)
			.LineTransparence = "50%"
		end with
	' Change Chart type
		oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.BubbleDiagram")
		msgbox "Success" & Chr$(10) & "(LO4.3.1.2)",0, "ChartArea"
End Sub
'

' [ Note ]
' Chart AreaのService( com.sun.star.chart.ChartArea[ LO / AOO ] )には、Line Service( com.sun.star.drawing.LineProperties )が含まれているがLO4.3.0.4では、反応無し。
'   ↓
' LO4.3.1.2 にて修正済

Sub CalcSimpleChart()
	Dim oDoc as Object, oSheet as Object
	Dim oCellA as Object, oCellB as Object
	Dim oRange As Object
	Dim oCharts As Object
	Dim oChart_Line As Object
	Dim oTitle As String
	Dim oRect As New com.sun.star.awt.Rectangle
	Dim oRangeAddress(0) As New com.sun.star.table.CellRangeAddress
		oDoc=ThisComponent
		oShtIndex = 0
		oSheet = oDoc.getSheets().getByIndex(oShtIndex)
		for i = 0 to 4
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellA.Value = i + 1
			oCellB.Formula = "=A" & (i + 1) & "*10"
		next i
	' Set Data Range
		oRange = oSheet.getCellRangeByName("A1:B5").getRangeAddress()
	' Set Sheet Index
		oRangeAddress(0).sheet = oRange.Sheet
	' Set X axis Data
		oRangeAddress(0).StartColumn = oRange.StartColumn
		oRangeAddress(0).EndColumn = oRange.EndColumn		' AOO4.1.1 ⇒  = 1 (oRange.EndColumn = 1024)
	' Set Y axis Data
		oRangeAddress(0).StartRow = oRange.StartRow
		oRangeAddress(0).EndRow = oRange.EndRow			' AOO4.1.1 ⇒  = 4 (oRange.EndColumn = 1048676)
	' Cahrt Object Size
		oRect.Height = 5000	'Unit : 1/100mm
		oRect.Width = 6000		'Unit : 1/100mm
		oRect.x = 1800  			' Unit : 1/100mm
		oRect.y = 100				' Unit : 1/100mm
	' 同名のChartは消す
		oTitle="Simple Chart"		' AOO4.1.1 ⇒ oTitle="SimpleChart" (Blank : NG) 
		oCharts=oSheet.getCharts()
		if oCharts.hasByName(oTitle) Then
			oCharts.RemoveByName(oTitle)
		end if
	' Draw Chart
		oCharts.addNewByName(oTitle,oRect,oRangeAddress(),True,True)
	' 指定TitleのChartを取得
		oChart_Line = oCharts.getByName(oTitle).embeddedObject
		oChart_Line.HasMainTitle = True
		oChart_Line.Title.String = oTitle
	'軸Title表示
		oChart_Line.diagram.HasXAxisTitle = true
		oChart_Line.diagram.XAxisTitle.String = "Data"
		oChart_Line.diagram.HasYAxisTitle = true
		oChart_Line.diagram.YAxisTitle.String = "Number of Cases"
	'X目盛の傾きset
		oChart_Line.diagram.XAxis.TextBreak = false
		oChart_Line.diagram.XAxis.TextRotation = 2700 'Unit: 1/100th of degree
	' Chartの種類を変更
		oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.NetDiagram")		''円折れ線グラフ
		'
	' Properties of Diagram
		oDiagram = oChart_Line.getFirstDiagram()
		oCooSys = oDiagram.getCoordinateSystems()
		oCoods = oCooSys(0)			' 上記で作成したChartには１つの座標軸しかないので
		'
		oChartTypes = oCoods.getChartTypes() ' chart type one by one
		oChartType = oChartTypes(0)
 		'
 		'　Data Seriesの取得
 		oDataSeriesList = oChartType.getDataSeries()
 		' Data Sereisの色変更
 		msgbox "Change color",0,"Data Series"
 		oDataSeriesList(0).Color = RGB(255,0,0)
 		'
 		msgbox "Success"
End Sub

画像

Sub oInsertPic
	Dim document as Object
    Dim dispather as Object
    	oDoc = ThisComponent
    		document = oDoc.CurrentController.Frame
    		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    ' ファイル選択ダイアログの初期化
    	Dim oFilePickerDlg as Object
    		oFilePickerDlg = createUnoService("com.sun.star.ui.dialogs.FilePicker")
    		oFilePickerDlg.appendFilter("JPEG画像ファイル(*.jpg, *.jpeg)", "*.jpg", "*.jpeg")
			
			If oFilePickerDlg.execute = 1 then
        		'ファイルが指定された場合
					Dim selFiles() as String
        				selFiles() = oFilePickerDlg.getFiles()

        			Dim picInfo(2) as new com.sun.star.beans.PropertyValue
        				picInfo(0).Name = "FileName"
        				picInfo(0).Value = selFiles(0)
        				picInfo(1).Name = "FilterName"
        				picInfo(1).Value = "JPEG - Joint Photograhpic Experts Group"
        				picInfo(2).Name = "AsLink"
        				picInfo(2).Value = false

	'ダイアログで指定された画像をアクティブセルへ挿入
        dispatcher.executeDispatch(document, ".uno:InsertGraphic","", 0, picInfo())
    End if
End Sub
'
' [ Note ]
BMP		:	Windows Bitmap
DXF		:	AutoCad Interchange Format
EMF		:	Enhanced Metafile
EPS		:	Encapsulated PostScript
GIF		:	Graphics Interface Format
JPEG	:	Joint Photographic Experts Group
MET		:	OS/2 Metafile
PBM		:	Portable Bitmap
PCD		:	Kodac Photo CD
PCT		:	Mac Pict
PCX		:	Zsoft Paintbrush
PGM		:	Portable Graymap
PNG		:	Portable Network Graphics
PPM		:	Portable Pixelmap
PSD		:	Adobe Photoshop
RAS		:	Sun Raster Image
SGF		:	StarWriter Graphic Format
SGV		:	StarDraw
SVM		:	StarView
TGA		:	Truevision
TIFF	:	Tagged Image File Format
WMF		:	Windows Metafile Format
XBM		:	X Bitmap
XPM		:	X Pixmap

印刷操作

Sub oPage_Break()
	Dim oDoc as Object, oSheet as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.Rows(9).IsStartOfNewPage = true 		'10行目の前(9行目の後)に改Pageを設定
		msgbox "改Page( 行 )設定",0,"改Page"
		'
		oSheet.Rows(9).IsStartOfNewPage = false
		msgbox "改Page( 行 )解除",0,"改Page"
		'
		oSheet.Columns(1).IsStartOfNewPage = true		' B列の前に改Page設定
		msgbox "改Page( 列 )設定",0,"改Page"
		'
		oSheet.Columns(1).IsStartOfNewPage = false
		msgbox "改Page( 列 )解除",0,"改Page"
End Sub

Sub oPage_Break()
	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")
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "9:9" 		'10行目の前(9行目の後)に改Pageを設定
		oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch( oFrame, ".uno:InsertRowBreak", "", 0, Array())
		msgbox "改Page( 行 )設定",0,"改Page"
		'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "9:9" 		'	毎回選択が必要
		Rem oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
		Rem oDispatcher.executeDispatch( oFrame, ".uno:DeleteRowbreak", "", 0, Array())	' ← 確認の為、Comment化
		Rem msgbox "改Page( 行 )解除",0,"改Page"
		'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "B:B" 		' B列の前に改Page設定
		oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch( oFrame, ".uno:InsertColumnBreak", "", 0, Array())
		msgbox "改Page( 列 )設定",0,"改Page"
		'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "B:B"
		Rem oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
		Rem oDispatcher.executeDispatch( oFrame, ".uno:DeleteColumnbreak", "", 0, Array())		' ← 確認の為、Comment化y())
		Rem msgbox "改Page( 列 )解除",0,"改Page"
End Sub

Sub Page_BreakMacro()
	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")
		'
		msgbox "全ての改Pageを解除します。",0,"改Page解除"
		oDispatcher.executeDispatch( oFrame, ".uno:DeleteAllBreaks", "", 0, Array())
		msgbox "全ての改Pageを解除しました。",0,"改Page解除"
End Sub

Sub PrintAreaMacro()
	Dim oPrintArea(0) as new com.sun.star.table.CellRangeAddress
	Dim oprops 		' com.sun.star.table.CellRangeAddress
	Dim oDummy()
   		On Error Goto oBad
			sName = "c:\temp\oDocProp.ods"
			sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		oSheet = oDoc.Sheets(0)
		ouno = "com.sun.star.sheet.XPrintAreas"
	'set Print Area
   			oPrintArea(0).StartColumn = 0
   			oPrintArea(0).StartRow = 0
   			oPrintArea(0).EndColumn = 9
   			oPrintArea(0).EndRow = 9
   		oDoc.Sheets(0).setPrintAreas( oPrintArea())
	'Store
		Dim oStore(0) as new com.sun.star.beans.PropertyValue
			oStore(0).name = "Overwrite"
			oStore(0).Value = true
		oDoc.storeAsURL(sURL, oStore())
		wait(10)
   	'get Print Area
   		If HasUnoInterfaces(oSheet, ouno) then
   			oprops = oSheet.getPrintAreas()
   				oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
   				oDisp = oDisp & "Sheet No" & Chr$(9) & Chr$(9) & " = " & oprops(0).Sheet & Chr$(10)
   				oDisp = oDisp & "Start Column " & Chr$(9) & " = " &  oprops(0).StartColumn & Chr$(10)
   				oDisp = oDisp & "End Column " & Chr$(9) & Chr$(9) & " = " &  oprops(0).EndColumn & Chr$(10)
   				oDisp = oDisp & "Start Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).StartRow & Chr$(10)
   				oDisp = oDisp & "End Row  " & Chr$(9) & Chr$(9) & " = " &  oprops(0).EndRow & Chr$(10)
   			msgbox(oDisp,0,"Print Area")
   		else
   			msgbox("This Document does not support" & Chr$(10) & _
						"the XPrintAreas interface",0,"Caution!!")
   		end If
   		oDoc.dispose
   		Exit sub
   oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
		oDoc.dispose
End Sub

Sub CalcPrintArea()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    	oDoc = ThisComponent
    	oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		msgbox "印刷範囲の設定済み。"
		oDispatcher.executeDispatch(oFrame, ".uno:DeletePrintArea", "", 0, Array())
		msgbox "印刷範囲を削除しました。" & Chr$(10) & "(DispatchHelper)",0,"Print Area"
End Sub

Sub oPrintTitle
	Dim oPrintArea(0) as new com.sun.star.table.CellRangeAddress
	Dim oprops 		' com.sun.star.table.CellRangeAddress
	Dim oDummy()
   		On Error Goto oBad
			sName = "c:\temp\oDocProp.ods"
			sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		oSheet = oDoc.Sheets(0)
		ouno = "com.sun.star.sheet.XPrintAreas"
	'set
   		oDoc.Sheets(0).setPrintTitleColumns( true)
	'Store
		Dim oStore(0) as new com.sun.star.beans.PropertyValue
			oStore(0).name = "Overwrite"
			oStore(0).Value = true
		oDoc.storeAsURL(sURL, oStore())
		wait(10)
   	'get Print Area
   		If HasUnoInterfaces(oSheet, ouno) then
   			oprops = oSheet.getPrintTitleColumns()
   				oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
   				oDisp = "Print Title for Columns => "
   				oDIsp = oDisp & oprops
   			msgbox(oDisp,0,"Print Title")
   		else
   			msgbox("This Document does not support" & Chr$(10) & _
						"the XPrintAreas interface",0,"Caution!!")
   		end If
   		oDoc.dispose
   		Exit sub
   oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
		oDoc.dispose
End Sub

Sub oPrintTitle
	Dim oTitleArea(0) as new com.sun.star.table.CellRangeAddress
	Dim oprops 		' com.sun.star.table.CellRangeAddress
	Dim oDummy()
   		On Error Goto oBad
			sName = "c:\temp\oDocProp.ods"
			sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		oSheet = oDoc.Sheets(0)
		ouno = "com.sun.star.sheet.XPrintAreas"
	'set
   			oTitleArea(0).StartColumn = 0
   			oTitleArea(0).StartRow = 0
   			oTitleArea(0).EndColumn = 15
   			oTitleArea(0).EndRow = 20
   		oSheet.setTitleColumns( oTitleArea(0))
	'Store
		Dim oStore(0) as new com.sun.star.beans.PropertyValue
			oStore(0).name = "Overwrite"
			oStore(0).Value = true
		oDoc.storeAsURL(sURL, oStore())
		wait(10)
   	'get Print Area
   		If HasUnoInterfaces(oSheet, ouno) then
   			oprops = oSheet.getTitleColumns()
   				oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
   			'	oDisp = "Print Title for Rows => "
   			'	oDIsp = oDisp & oprops
   				oDisp = oDisp & "Sheet No" & Chr$(9) & Chr$(9) & " = " & oprops(0).Sheet & Chr$(10)
   				oDisp = oDisp & "Start Column " & Chr$(9) & " = " &  oprops(0).StartColumn & Chr$(10)
   				oDisp = oDisp & "End Column " & Chr$(9) & Chr$(9) & " = " &  oprops(0).EndColumn & Chr$(10)
   			'	oDisp = oDisp & "Start Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).StartRow & Chr$(10)
   			'	oDisp = oDisp & "End Row  " & Chr$(9) & Chr$(9) & " = " &  oprops(0).EndRow & Chr$(10)
   			msgbox(oDisp,0,"Print Title")
   		else
   			msgbox("This Document does not support" & Chr$(10) & _
						"the XPrintAreas interface",0,"Caution!!")
   		end If
   		oDoc.dispose
   		Exit sub
   oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
		oDoc.dispose
End Sub

Sub oPrintTitle
	Dim oPrintArea(0) as new com.sun.star.table.CellRangeAddress
	Dim oprops 		' com.sun.star.table.CellRangeAddress
	Dim oDummy()
   		On Error Goto oBad
			sName = "c:\temp\oDocProp.ods"
			sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		oSheet = oDoc.Sheets(0)
		ouno = "com.sun.star.sheet.XPrintAreas"
	'set
   		oDoc.Sheets(0).setPrintTitleRows( true)
	'Store
		Dim oStore(0) as new com.sun.star.beans.PropertyValue
			oStore(0).name = "Overwrite"
			oStore(0).Value = true
		oDoc.storeAsURL(sURL, oStore())
		wait(10)
   	'get Print Area
   		If HasUnoInterfaces(oSheet, ouno) then
   			oprops = oSheet.getPrintTitleRows()
   				oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
   				oDisp = "Print Title for Rows => "
   				oDIsp = oDisp & oprops
   			msgbox(oDisp,0,"Print Title")
   		else
   			msgbox("This Document does not support" & Chr$(10) & _
						"the XPrintAreas interface",0,"Caution!!")
   		end If
   		oDoc.dispose
   		Exit sub
   oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
		oDoc.dispose
End Sub

Sub oPrintTitle
	Dim oTitleArea(0) as new com.sun.star.table.CellRangeAddress
	Dim oprops 		' com.sun.star.table.CellRangeAddress
	Dim oDummy()
   		On Error Goto oBad
			sName = "c:\temp\oDocProp.ods"
			sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		oSheet = oDoc.Sheets(0)
		ouno = "com.sun.star.sheet.XPrintAreas"
	'set
   			oTitleArea(0).StartColumn = 0
   			oTitleArea(0).StartRow = 0
   			oTitleArea(0).EndColumn = 15
   			oTitleArea(0).EndRow = 20
   		oSheet.setTitleRows( oTitleArea(0))
	'Store
		Dim oStore(0) as new com.sun.star.beans.PropertyValue
			oStore(0).name = "Overwrite"
			oStore(0).Value = true
		oDoc.storeAsURL(sURL, oStore())
		wait(10)
   	'get Print Area
   		If HasUnoInterfaces(oSheet, ouno) then
   			oprops = oSheet.getTitleRows()
   				oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
   			'	oDisp = "Print Title for Rows => "
   			'	oDIsp = oDisp & oprops
   				oDisp = oDisp & "Sheet No" & Chr$(9) & Chr$(9) & " = " & oprops(0).Sheet & Chr$(10)
   			'	oDisp = oDisp & "Start Column " & Chr$(9) & " = " &  oprops(0).StartColumn & Chr$(10)
   			'	oDisp = oDisp & "End Column " & Chr$(9) & Chr$(9) & " = " &  oprops(0).EndColumn & Chr$(10)
   				oDisp = oDisp & "Start Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).StartRow & Chr$(10)
   				oDisp = oDisp & "End Row  " & Chr$(9) & Chr$(9) & " = " &  oprops(0).EndRow & Chr$(10)
   			msgbox(oDisp,0,"Print Title")
   		else
   			msgbox("This Document does not support" & Chr$(10) & _
						"the XPrintAreas interface",0,"Caution!!")
   		end If
   		oDoc.dispose
   		Exit sub
   oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
		oDoc.dispose
End Sub

Sub PrintArea()
	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
    	' 改Page設定
    	oSheet = oDoc.getSheets().getByIndex(0)
  		oSheet.Rows(5).IsStartOfNewPage = true 		'　6行目の前(5行目の後)に改ページを設定
  		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A1:C10"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:DeletePrintArea", "", 0, oProp())
    	' Row Title 設定
    		oProp(0).Name = "PrintRepeatRow"
    		oProp(0).Value = "1:1"
    	oDispatcher.executeDispatch(oFrame, ".uno:ChangePrintArea", "", 0, oProp())	
    	'
    msgbox "Success"
End Sub
'
' [ Note ]
' "PrintRepeatCol" は設定不可

Sub CalcPrintScale()
	Dim oDoc as Object
	Dim oPstyleName as String
	Dim oStyle as Object
		oDoc = ThisComponent	
		oPstyleName = oDoc.CurrentController.getActiveSheet().PageStyle
		oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPstyleName)
		oStyle.PageScale = 80			' ← 80%
		msgbox "Success",0,"Print Zoom"
End Sub

Sub UnoPrint()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:ResetPrintZoom", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

Sub HeaderFooter()
	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:EditHeaderAndFooter", "", 0, Array())
End Sub
'
' [ Note ]
' Calcのみ。Writerでは動作しない
' 書式 → Page → Header/Footer
' LO4.0.1 の UI からはHeadr or Footerの何れかのDialogのみだが、
' 上記Codeで表示されるDialogではheader/Footerが1つのDialogのTab Page区切りで設定出来る

[ Prinetr ]

Sub CalcSheetStting()
	Dim oDoc as Object
	Dim oSpdSht as Object
	Dim oPrtName as String
		oDoc = ThisComponent
  		oSpdSht = oDoc.createInstance("com.sun.star.comp.SpreadsheetSettings")
  		oPrtName = oSpdSht.PrinterName
  		oDisp = "[ Default Printer Name ]" & Chr$(10) & oPrtName
  		'
  		msgbox oDisp, 0, "Printer"
End Sub

file操作

Sub oCalcOpen_Dummy
	dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
		oAns = Msgbox("ファイルを閉じますか?",4, "File Close確認")
		if oAns = 6 then
			oDoc.dispose
		End if
End Sub
'
' [ Note ]
' "_blank"   : Create a new frame 
' "_default" : Detects an already load document or create a new frame if it is not found
' "_parent"  : Use or return the direct parent of this frame
' "_top"     : Use or return the highest level parent frame
' "_beamer"  : Use or return special subframe
' "_self"    : load current frame

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

Sub oCalcOpen_Name
	Dim Dummy()
		oName = "c:\temp\test.ods"
		oUrl = ConvertToURL(oName)
		oDoc = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, Dummy())
		oAns = Msgbox("ファイルを閉じますか?",4, "File Close確認")
		if oAns = 6 then
			oDoc.dispose
		End if
End Sub

Sub oCalcOpen_CSV
	Dim oDoc as Object
	Dim oName as String
	Dim oUrl as String
	Dim oCSV(1) As New com.sun.star.beans.PropertyValue
		oName = "c:\OOo_Macro.csv"
		oUrl = ConvertToURL(oName)
		oCSV(0).Name = "FilterName"
		oCSV(0).Value = "scalc: Text - txt - csv (StarCalc)"
		oCSV(1).Name = "FilterOptions"
		oCSV(1).Value = "44/32,34,0,1,1/2/2/3/2/4/2"
	oDoc = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, oCSV())
End Sub
'
'[ Note ] : ASCII Value,Text Portion,CharactorSet(Default:0),1(Field_Num)/Format/2/Format/･･･/10/Format
'[ ASCII_Value ]
'	44	:	Comma(,)
'	32	:	Space
'	9	:	Tab
'[ Format ]
'	1	:	Standard
'	2	:	Text
'	3	:	MM/DD/YY
'	4	:	DD/MM/YY
'	5	:	YY/MM/DD
'	9	:	Do not Import
'	10	:	Format in the US-English locale regardless of the current locale.

Sub oCalcOpen()
	Dim oDoc as Object
	Dim oFileName as String
	Dim oFileUrl as String
	Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
		oFileName = "c:\temp\CalcTest01.html"
		oFileUrl = ConvertToURL(oFileName)
		oFilterName(0).Name = "FilterName"
		oFilterName(0).Value = "scalc: calc_HTML_WebQuery"
	oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub
'
' [ Note ]
' calc_HTML_WebQueryはImportのみ
' HTML(StarCalc) ではWriterが起動

Sub oCalcOpen()
	Dim oDoc as Object
	Dim oFileName as String
	Dim oFileUrl as String
	Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
		oFileName = "c:\temp\CalcTest01.slk"
		oFileUrl = ConvertToURL(oFileName)
		oFilterName(0).Name = "FilterName"
		oFilterName(0).Value = "scalc: SYLK"
	oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub

Sub oCalcOpen()
	Dim oDoc as Object
	Dim oFileName as String
	Dim oFileUrl as String
	Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
		oFileName = "c:\temp\Excel2003Test.xls"
		oFileUrl = ConvertToURL(oFileName)
		oFilterName(0).Name = "FilterName"
		oFilterName(0).Value = "scalc: MS Excel 2003"
	oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub

Sub oCalcOpen()
	Dim oDoc as Object
	Dim oFileName as String
	Dim oFileUrl as String
	Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
		oFileName = "c:\temp\Excel2007Test.xlsx"
		oFileUrl = ConvertToURL(oFileName)
		oFilterName(0).Name = "FilterName"
		oFilterName(0).Value = "scalc: MS Excel 2007"
	oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub

Sub oCalcOpen()
	Dim oDoc as Object
	Dim oFileName as String
	Dim oFileUrl as String
	Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
		oFileName = "c:\temp\CalcTest01.xml"
		oFileUrl = ConvertToURL(oFileName)
		oFilterName(0).Name = "FilterName"
		oFilterName(0).Value = "scalc: MS Excel 2003 XML"
	oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub

Sub DocProtect()
	Dim oDoc as Object
	Dim oPW as String, oDisp as String
	Dim oAns as Long
		oDoc = ThisComponent
		oPW = "pass"
		if NOT oDoc.isProtected() Then
			oDoc.protect(oPW)
			if oDoc.isProtected() Then
				oDisp = "Documentの保護設定しました" & Chr$(10) & "但し、閲覧は可能です"
			else
				oDisp = "Documentの保護設定に失敗しました"
				msgbox oDisp,0,"Protect(LO4.2.4)"
				Exit Sub
			end if
		else
			oDisp = "既に保護状態です。"
		end If
		msgbox oDisp,0,"Protect(LO4.2.4)"
		' Unprotect
		oDisp = "Password = " & oPW & Chr$(10) & "ですか？"
		oAns = msgbox(oDisp, 4, "Passwordの確認")
		if oAns = 6 then
			oDoc.unprotect(oPW)
			if NOT oDoc.isProtected() Then
				oDisp = "Documentの保護を解除"
			else
				oDisp = "Documentの保護解除に失敗しました"
			end if
		else
			oDisp = "Passwordを調べて下さい"
		end if
		msgbox oDisp,0,"Unprotect(LO4.2.4)"
End Sub

Sub DocProtect()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame, ".uno:ToolProtectionDocument", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CSV file操作

Sub oCSV
	On Error Goto oBad
	Dim oCSVFile as String
	Dim oVal(10,10) as Long
	Dim i, j as Integer
	Dim n as Integer
		n = 0
		for i = 0 to 10
			for j = 0 to 10
				oVal(i,j) = n
				n =  n + 1
			next j
		next i
		'
		oCSVFile = "C:\Temp\OOoTest.csv"
		Open oCSVFile For Output As #1
		for j = 0 to 10
			oDisp = ""
			for i = 0 to 10
			 oDisp = oDisp & oVal(i, j) & ","
			next i
			Print #1,oDisp
		next j 
		' 
		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

Web関係

Sub Excel_Save Dim oUrl as String 
	Dim oDoc as Object
	Dim oPropertyValue(0) As New com.sun.star.beans.PropertyValue
	Dim document as object Dim dispatcher as object
	Dim args1(1) as new com.sun.star.beans.PropertyValue
		icompany_symbol="GOOG" 
		oUrl="http://ichart.finance.yahoo.com/table.csv" & "?s=" & icompany_symbol & "&e=.csv"
		oPropertyValue(0).Name="FilterOptions"
		oPropertyValue(0).Value="44"
		oDoc=starDeskTop.LoadComponentFromURL( oUrl, "_blank", 0, oPropertyValue)
		document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			args1(0).Name = "Filename"
			args1(0).Value = "C:\Google_Stock.xls"
			args1(1).Name = "FilterOprtion"
			args1(1).Value = "MS Excel 97"
		dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
		oDoc.close(false) 
End Sub

Sub YahooStock()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp1(2) as new com.sun.star.beans.PropertyValue
	Dim oUrl as String, oSymbol as String
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oSymbol = "GOOG"		' Google
		oUrl = "http://finance.yahoo.com/q/hp?s=" & oSymbol & "+Historical+Prices"
		'
		oProp1(0).Name = "FileName"
		oProp1(0).Value = oUrl
		oProp1(1).Name = "FilterName"
		oProp1(1).Value = "calc_HTML_WebQuery"
		oProp1(2).Name = "Source"
		oProp1(2).Value = "HTML_14"
		oDispatcher.executeDispatch(oFrame, ".uno:InsertExternalDataSource", "", 0, oProp1())
		'
		msgbox "Success"
End Sub

その他

Sub Main
	Dim oDoc As object
 	Dim oDescriptor as Object
 	Dim oFound as Object
	dim args1(0) as new com.sun.star.beans.PropertyValue
	dim document as object
	dim dispatcher as object
	dim args2(0) as new com.sun.star.beans.PropertyValue	
		document   = ThisComponent.CurrentController.Frame
		documentView = ThisComponent.CurrentController
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")	
	 		oDoc=ThisComponent				
 			oSheets1 = oDoc.Sheets	
			oSheetcount = oSheets1.getcount() 	'sheet数を数える 
			for i=0 to oSheetcount-1
 				oSheet=oDoc.Sheets(i)
 				args2(0).Name = "Nr"
				args2(0).Value = i +1		'sheet番号
			dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args2())
 				args1(0).Name = "Sel"
				args1(0).Value = false
			dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args1())
			ActiveColumn=oDoc.CurrentController.getSelection().RangeAddress.StartColumn		
 			ActiveRow=oDoc.CurrentController.getSelection().RangeAddress.StartRow
 			for j=0 to ActiveColumn
 				for k=0 to ActiveRow
					if oSheet.getCellByPosition(j,k).CellBackColor=RGB(255,0,0) then '全シートのcellの背景がｒｅｄの数を調べる
						Red_Count=Red_Count+1
					end if
				next k
			next j
 		next i
 	print Red_Count
End Sub

Sub Main()
	Url = "file:///C:\TEST\2-1-2_OOo_ブックを開く\読込みパスワード.xls"
	FileProperties(0).Name = "Password"
	FileProperties(0).Value ="nck1"
	Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, FileProperties())
End Sub

Sub InsertData()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame, ".uno:InsertExternalDataSource", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub