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

< 前 Calc No.4 次 >

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

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


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


Data Pilot



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


Scenario


Graph Chart作成


画像


印刷操作


[ Prinetr ]



file操作



CSV file操作



Web関係



その他












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

View

CVw-)[Calc]Page Preview Mode/Normal Mode表示


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

CVw-)[Calc]Page Breake Line表示/非表示


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

CVw-)[Calc]式入力Boxの表示/非表示


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

CVw-)[Calc]関数Listの表示/非表示


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

CVw-)[Calc]行･列番号表示/非表示(1)


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

CVw-)[Calc]行･列番号表示/非表示(2)


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

CVw-)[Calc]行･列番号表示/非表示(3)


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

CVw-)[Calc]値の強調表示/非表示(1)


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

CVw-)[Calc]値の強調表示/非表示(2)


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

CVw-)[Calc]値の強調表示/非表示(3)


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

CSVw-)[Calc]画面Zoomの設定( Only Calc )


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 で設定できる。

CVw-)[Calc]Gride Line表示/非表示


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

CVw-)[Calc]Gride Lineの色設定


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

CVw-)[Calc]Spell記号の表示/非表示(未完成)

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

CVw-)[Calc]水平Scroll Bar表示/非表示


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

CVw-)[Calc]垂直Scroll Bar表示/非表示


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

CVw-)[Calc]Outline記号の表示/非表示(1)


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

CVw-)[Calc]Outline記号の表示/非表示(2)


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

CVw-)[Calc]DocumentのSheet Tabの表示/非表示(1)


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

CVw-)[Calc]DocumentのSheet Tabの表示/非表示(2)


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

CVw-)[Calc]DocumentのSheet Tab表示/非表示Check

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 ) を使う

CVw-)[Calc]Object Anchorの表示/非表示


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

CVw-)[Calc]Objectの表示/非表示


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

CVw-)[Calc]ObjectのHelp Line表示/非表示


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

CVw-)[Calc]Embedded Objectの表示/非表示


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 )

CVw-)[Calc]Formula表示


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

CVw-)[Calc]Zero( = 0 )表示/非表示


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

CVw-)[Calc]Commentの表示/非表示(1)


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

CVw-)[Calc]Commentの表示/非表示(2)

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

CVw-)[Calc]Comment Markの表示/非表示


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

CVw-)[Calc]Option → Grid Lineの設定取得


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

CVw-)[Calc]


Document Setting

CSDS-)[Calc]Auto Spell Check ON/OFF( Only Calc )


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 を参照


CSDS-)[Calc]OpenXml形式で保存する時のDefaultTabStop値取得


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


CSDS-)[Calc]


Data Pilot

CDP-1)[Calc]Data Pilot Sourceの作成


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

CDP-)[Calc]Data Pilot Tableの作成


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

CDP-)[Calc]Data Pilot Tableの削除

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

CDP-)[Calc]Pilot Table作成Dialog表示


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

CDP-)[Calc]


GoalSeek

CGS-)[Calc]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

CGS-)[Calc]GoalSeek Dialog表示


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

CGS-)[Calc]








Scenario

CGS-)[Calc]Scenarioの作成/削除(1)


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に詳しく記されています。

CGS-)[Calc]Scenarioの作成/削除(2)


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に表示されない。

CGS-)[Calc]Properties of Service 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")
		'
	' 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

CGS-)[Calc]ScenarioのCommnet取得/設定


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

CGS-)[Calc]Scenarioの有無Check


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

CGS-)[Calc]名前を指定してScenarioの有無Check


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

CGS-)[Calc]


Graph Chart作成

CG-)[Calc]各種Graph作成(0)


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

CG-)[Calc]各種Graph作成(1)


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

CG-)[Calc]各種Graph作成(1A)


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

CG-)[Calc]各種Graph作成(2)


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

CGhCt-)[Calc]各種Graph作成(3)


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

CGhCt-)[Calc]Graph作成Wizard表示(1)


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


CGhCt-)[Calc]Graph作成Wizard表示(2)


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


CGhCt-)[Calc]Chart AreaのProperties


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 にて修正済


CGhCt-)[Calc]Data SeriesのProperties


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



画像

CGrc-1)[Calc]画像dataの挿入

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


印刷操作

CP-)[Calc]改Pageの挿入/解除(1)

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

CP-)[Calc]改Pageの挿入/解除(2)


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

CP-)[Calc]全ての改Pageの解除


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


CP-)[Calc]印刷範囲を設定する。


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

CP-)[Calc]印刷範囲を削除する


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


CP-)[Calc]Column TitleをONにする


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

CP-)[Calc]Column Title範囲を設定する


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

CP-)[Calc]Row TitleをONにする


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

CP-)[Calc]Row Title範囲を設定する(1)


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

CP-)[Calc]Row Title範囲を設定する(2)

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" は設定不可

CP-)[Calc]印刷倍率を設定


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


CP-)[Calc]印刷倍率を設定をReset


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


CP-)[Calc]Header/Footer Dialog表示


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区切りで設定出来る

CP-)[Calc]









[ Prinetr ]

CPPrt-)[Calc]Default Printer Name取得


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

CPPrt-)[Calc]>Header/Footer Dialog表示

CPPrt-)[Calc]


file操作

CF-1)[Calc]新規Calc 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

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

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

CF-3)[Calc]指定のCalc fileを開く(c:\temp\test.ods)。

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

CF-4)[Calc]CSV形式fileを開く。

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.

CF-)[Calc]Html形式Fileを開く

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が起動

CF-)[Calc]SYLK形式形式Fileを開く

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

CF-)[Calc]xls形式Fileを開く

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

CF-)[Calc]xlsx形式Fileを開く

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

CF-)[Calc]MS-Excel 2003 XML形式Fileを開く

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

CF-)[Calc]Documentの保護/保護解除( Only Calc )


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

CF-)[Calc]「Documentの保護」Dialog表示( Only Calc )


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

CF-)[Calc]


CSV file操作

CCsv-1)[Calc]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関係

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

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

CWeb-)[Calc]Yahoo FinanceよりStock( Google )のHistorical Price取得


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

その他

CO-)[Calc]全Sheetにおいてセルの背景色（Red)の累計を数える

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

CO-)[Calc]Excelのパスワード付ファイルを開ける

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

CO-)[Calc]「挿入」⇒「外部データへのリンク」Dialog表示


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

CO-)[Calc]




Top of Page

inserted by FC2 system