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



Sub CalcSheet()
	Dim oDoc as Object, oCtrl as Object, oActSht as Object
	Dim ActiveSheetName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oActSht = oCtrl.getActiveSheet()
		ActiveSheetName = oActSht.Name
		oDisp = "[ Active Sheet ]" & Chr$(10) & "Name : " & ActiveSheetName
		msgbox(oDisp, 0, "Active Sheet")
End Sub

CS-)[Calc]Current CellのSheet名を取得



Sub CalcSpreadSht()
	Dim oDoc as Object
	Dim oActiveCell as Object
	Dim oSht as Object
	Dim oShtName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oActiveCell = oDoc.CurrentSelection
		oSht = oActiveCell.spreadsheet
		oShtName = oSht.Name
		oDisp = "Current Sheet Name" & Chr$(10) & "→ " & oShtName
		msgbox oDisp, 0, "CellからSheet名取得"
End Sub

CS-2)[Calc]全てのSheet名を取得



Sub CalcSheet()
	Dim oDoc as Object
	Dim oSeet as Object
	Dim oEnum as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSeet = oDoc.getSheets()
		oEnum = oSeet.createEnumeration()
		'
		oDisp = "[ Names of All Sheet ]" & Chr$(10)
 		While ( oEnum.hasMoreElements() )
  			oDisp = oDisp & oEnum.nextElement.Name & Chr$(10)
 		WEnd
		msgbox(oDisp, 0, "Sheet Name")
End Sub

CS-)[Calc]Sheet名があるかどうかを調べる。



Sub CalcSheet()
	Dim oDoc As Object
	Dim oSheet As Object
	Dim oShtName As String
	Dim oDisp as String
   		oDoc = ThisComponent
   		oSheet = oDoc.getSheets()
   		oShtName = "Sheet1"
   		oDisp = "Sheet Name = " & oShtName & Chr$(10)
   		If oSheet.hasByName( oShtName ) Then
     		oDisp = oDisp & "は、同名Sheetが既にあります。"
     	else
     		oDisp = oDisp & "の同名Sheetはありません。" 
   		End If
   		msgbox(oDisp, 0, "同名Sheet")
End Sub

CS-)[Calc]Sheetの新規挿入(1)



Sub CalcSheet()
	Dim oDoc As Object
	Dim oSheet As Object
	Dim oShtName As String
	Dim oDisp as String
  		oDoc = ThisComponent 				'calc doc
  		oSheet = oDoc.getSheets()
  		oShtName = "NewSheet" 				'←新しいsheetの名前
  		oDisp = "新規Sheet : " & oShtName & Chr$(10)
  		If NOT oSheet.hasByName( oShtName ) Then	'←先に同名のsheetがないかCheck
  			oSheet.insertNewByName( oShtName, 0 )				' 0 は挿入位置( 先頭 )
  			oDisp = oDisp & "が挿入されました"
  		else
  			oDisp = oDisp & "は既に同名Sheetが存在しています"
  		End If
  	msgbox(oDisp, 0, "Sheetの挿入")
End Sub

CS-)[Calc]Sheetの新規挿入(2)



Sub CalcSheet()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oSpdSht as Object
	Dim oShtName as String
	Dim oDisp as String
  		oDoc = ThisComponent 				'calc doc
  		oSheet = oDoc.getSheets()
  		oShtName = "NewSheet(2)" 				'←新しいsheetの名前
  		'
  		' com.sun.star.sheet.spreadsheet serviceをInstance化
  		oSpdSht = oDoc.createInstance("com.sun.star.sheet.Spreadsheet")
  		'
  		oDisp = "新規Sheet : " & oShtName & Chr$(10)
  		If NOT oSheet.hasByName( oShtName ) Then 				' ←先に同名のsheetがないかCheck
  			oSheet.insertByName( oShtName, oSpdSht )				' ←挿入位置は末尾
  			oDisp = oDisp & "が挿入されました"
  		else
  			oDisp = oDisp & "は既に同名Sheetが存在しています"
  		End If
  	msgbox(oDisp, 0, "Sheetの挿入")
End Sub

CS-)[Calc]Sheetの新規挿入(3)


Sub CalcSheet()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(1) 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 = "Name"
  			oProp(0).Value = "AddSht"
  			oProp(1).Name = "Index"
  			oProp(1).Value = 2			' Sheet2 の前に挿入 / 先頭は1
  		oDispatcher.executeDispatch( oFrame, ".uno:Insert", "", 0, oProp())
  		msgbox "Success"
End Sub

CS-)[Calc]Sheet内容の置換


Sub CalcSheet()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oSpdSht as Object
	Dim oBaseShtName as String, oRplcShtName as String
	Dim oDisp as String
  		oDoc = ThisComponent
  		oSheet = oDoc.getSheets()
  		oBaseShtName = "Sheet1"
  		oRplcShtName = "Sheet3"
  		'
  		oSpdSht = oDoc.createInstance("com.sun.star.sheet.Spreadsheet")
  		'
  		If oSheet.hasByName( oBaseShtName ) Then
  			oSpdSht.setName(oBaseShtName)						' ← setName が設定出来ないので空白Sheetが置換元になる( 理由不明 )
  			msgbox oSpdSht.getName()
  		else
  			oDisp = "置換元Sheet : " & oBaseShtName & Chr$(10) & "が存在しません。"
  			msgbox(oDisp,0,"置換元Sheet")
  			Exit Sub
  		end If
  		'
  		If oSheet.hasByName( oRplcShtName ) Then
  			oSheet.replaceByName( oRplcShtName, oSpdSht )
  			oDisp = oRplcShtName & " の内容を " & Chr$(10) & oBaseShtName & Chr$(10) & "の内容 に置換しました。"
  		else
  			oDisp = "置換先Sheet : " & oRplcShtName & Chr$(10) & "が存在しません。"
  			msgbox(oDisp,0,"置換先Sheet")
  			Exit Sub
  		end If
  	msgbox(oDisp,0,"Sheetの置換")
End Sub

CS-)[Calc]Sheetの保護/保護解除



Sub CalcSheet()
	Dim oDoc as Object, oCalcSht as Object, oSheet as Object
	Dim oShtName as String, oDisp as String
  		oDoc = ThisComponent
  		oCalcSht = oDoc.getSheets()
  		oShtName = "Sheet1"
  		'
  		oSheet = oCalcSht.getByName(oShtName)
  		'
  		oDisp = "Sheet名 : " & oShtName & Chr$(10)
  		if NOT oCalcSht.getByName(oShtName).IsProtected then
  			oSheet.protect("password")
  			if oCalcSht.getByName(oShtName).IsProtected then
  				oDisp = oDisp & "を 保護しました。"
  			else
  				oDisp = oDisp & "に失敗しました。"
  				msgbox(oDisp, 0, "Sheetの保護")
  				Exit Sub
  			end if
  			
  		else
  			oDisp = oDisp & "は既に保護されています。"
  		end if
  		msgbox(oDisp, 0, "Sheetの保護")
  		'
  		oSheet.unprotect("password")
  		oDisp = "Sheet名 : " & oShtName & Chr$(10)
  		if NOT oCalcSht.getByName(oShtName).IsProtected then
  			oDisp = oDisp & "の 保護を解除しました。"
  		else
  			oDisp = oDisp & "の解除に失敗しました。"
  		end if
  		msgbox(oDisp, 0, "Sheetの保護解除")
End Sub

CS-)[Calc]Sheetの保護Dialog表示



Sub CalcSht()
    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:Protect", "", 0, Array())
		'
		msgbox "Success" & Chr$(10) & "( DispatchHelper )",0,"LO4.2.4"
End Sub

CS-)[Calc]SheetのCopy


Sub CalcSheet()
Dim oDoc As Object
Dim oSheets As Object
Dim sSheetName As String
Dim sCopyName As String
  sSheetName = "Sheet1" '←コピー元のSheet名
  sCopyName = "Copy"	'←コピー先のSheet名
  oDoc = ThisComponent 'calc doc
  oSheets = oDoc.getSheets()
  If oSheets.hasByName( sSheetName ) Then
    If NOT oSheets.hasByName( sCopyName ) Then
      oSheets.copyByName( sSheetName, sCopyName, 0 )
    End If
  End If
End Sub

CS-)[Calc]Sheetの移動


Sub CalcSheet()
Dim oDoc As Object, oSheets As Object
Dim sSheetName As String
  sSheetName = "Sheet1"
  oDoc = ThisComponent 'calc doc
  oSheets = oDoc.getSheets()
  If oSheets.hasByName( sSheetName ) Then
      oSheets.moveByName( sSheetName, 0 )	'←一番前に移動
  End If
End Sub

CS-)[Calc]Current SheetのCopy/移動



Sub CalcSheet()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(2) as new com.sun.star.beans.PropertyValue
	Dim oDocName as String
  		oDoc = ThisComponent
  		oCtrl = oDoc.getCurrentController()
  		oFrame = oCtrl.getFrame()
  		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		oDocName = Replace(oDoc.getTitle(), " ", "" )		' ← 文字間のSpace削除する必要あり
  			oProp(0).Name = "DocName"
  			oProp(0).Value = oDocName
  			oProp(1).Name = "Index"
  			oProp(1).Value = 1		' 1 : 先頭 / Sheet2の前は 2
  			oProp(2).Name = "Copy"
  			oProp(2).Value = true		' true : Copy / false : Move
  		oDispatcher.executeDispatch( oFrame, ".uno:Move", "", 0, oProp())
  		msgbox "Success"
End Sub

CS-)[Calc]Sheetの削除


Sub CalcSheet()
	Dim oSheets As Object
	Dim oSheet As Object
	Dim nReturnCode As Integer
	Dim sSheetName As String
   		sSheetName = "NewSheet2"
   		oSheets = ThisComponent.getSheets()
   		If oSheets.hasByName( sSheetName ) Then
     		nReturnCode=Msgbox("本当に削除しますか?",4)
     		if nReturnCode=6 then
     			oSheets.removeByName( sSheetName )
     		Endif
    	else
    		msgbox("削除するsheetがありません") 
   		End If
End Sub

CS-)[Calc]Current Sheetの削除



Sub CalcSheet()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp() 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:Remove", "", 0, oProp())
  		msgbox "Success"
End Sub

CS-)[Calc]Sheet名の変更(1)


Sub oChangeSheetName
Dim oDoc As Object, oSheet1 as Object
	oDoc = ThisComponent
	oSheet1=oDoc.Sheets(0)
	oSheet1.Name="Calc1"
End Sub

CS-)[Calc]Sheet名の変更(2)[ Current Sheet ]



Sub CalcValidation()
    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 = "Name"
			oProp(0).Value = "ChangeSht"
		oDispatcher.executeDispatch(oFrame,  ".uno:RenameTable", "", 0, oProp())
		'
		msgbox "Success"
End Sub

CS-)[Calc]Sheetの表示/非表示(1)



Sub SheetShowHide()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oShtName as String
	Dim oDisp as String
		oDoc = ThisComponent
		oShtName = "Sheet3"
		oSheet = oDoc.getSheets().getByName(oShtName)
		oSheet.IsVisible = false
    	msgbox(oShtName & " は 非表示",0,"Sheet表示")
    	'
    	oSheet.IsVisible = true
    	msgbox(oShtName & "Sheet は 表示",0,"Sheet表示")
End Sub

CS-)[Calc]Sheetの表示/非表示(2)



Sub SheetShowHide()
	Dim oDoc As Object
	Dim oCtrl as Object
	Dim oFrame as Object
	Dim oShtName as String
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oDisp as String
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    	'
    	oShtName = "Sheet2"
    	' 先頭の a に注意 / "Nr" を用いる時は先に .uno:JumpToTable とset
    	oProp(0).Name = "aTableName"		
		oProp(0).Value = "Sheet2"				'  Propertiesを設定しないと ActiveSheet
		'
    	oDispatcher.executeDispatch(oFrame, ".uno:Hide", "", 0, oProp())
    	msgbox(oShtName & " は 非表示",0,"Sheet表示")
    	'
    	' 表示時は oProp(0).Name = "Nr" での指定は無視される
    	oDispatcher.executeDispatch(oFrame, ".uno:Show", "", 0, oProp())
    	msgbox(oShtName & "Sheet は 表示",0,"Sheet表示")
End Sub

CS-)[Calc]Sheet Tab Colorの取得 / 設定



Sub SheetTab()
	Dim oDoc As Object
	Dim oSheets as Object, oSheet1 as Object, oSheet2 as Object
	Dim oShtColor1 as Long, oShtColor2 as Long
	Dim oSht2Color as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oSheets = oDoc.getSheets()
		oSheet1 = oSheets.getByIndex(0)
		oSheet2 = oSheets.getByIndex(1)
		'
		' TabColor to be applied after OOo3.3
		oShtColor1 = oSheet1.TabColor
		oSht2Color = oSheet2.TabColor
		'
		oSheet1.TabColor = RGB(255,0,0)
		oShtColor2 = oSheet1.TabColor
		'
		oDisp = "[ Sheet Tab Color ]" & Chr$(10) & "{ Sheet1 }" & Chr$(10) & "Before = " & Hex(oShtColor1) & Chr$(10) &_
					"After  = " & Hex(oShtColor2) & Chr$(10) & Chr$(10) & "{ Sheet2 }" & Chr$(10) & Hex(oSht2Color)
					'
	' macro実行中に確認する為に、Active Sheetを変更
	Dim oCtrl as Object
		oCtrl = oDoc.getCurrentController()
		oCtrl.setActiveSheet(oSheets.getByName("Sheet1"))
  		oCtrl.setActiveSheet(oSheets.getByName("Sheet3"))
		msgbox(oDisp, 0, "Change Tab Color of Sheet")
End Sub

CS-)[Calc]Sheet背景色の設定



Sub BackColorOfSheet()
	Dim oDoc as Object, oSheet as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.CellBackColor = RGB(150,254,150)
		msgbox "Change Back Color!!",0,"Sheet"
		' 解除
		oSheet.CellBackColor = -1
		msgbox "Success"
End Sub

CS-)[Calc]Sheet Style取得


Sub Main()
Dim oSheets As Object
Dim oSheet As Object
Dim sSheetName As String
   	sSheetName = "sheet1" '←調べるsheet名
   	oSheets = ThisComponent.getSheets()
	oSheet = oSheets.getByName( sSheetName ) 
 	PStyle=oSheet.getPropertyValue( "PageStyle" )
Msgbox(PStyle)
End Sub

CS-)[Calc]Current Sheet Style取得



Sub CalcPageStyle()
	Dim oDoc as Object, oSheet as Object 
	Dim oPageStyle as String
		oDoc = ThisComponent
		oSheet = oDoc.CurrentController.getActiveSheet()
		oSheetStyle	= oSheet.PageStyle
		oDisp = oSheetStyle
	msgbox oDisp,0,"Sheet Style" 	
End Sub

CS-)[Calc]Page Size取得



Sub oSheet
	Dim oDoc
	Dim oSheet
	Dim oPageStyle
		oDoc = ThisComponent
			oSheet = oDoc.CurrentController.getActiveSheet()
			oSheetStyle	= oSheet.PageStyle
				oSheetStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oSheetStyle) 
			oPageH  = oSheetStyle.Height /100		' unit : 1/100 mm
			oPageW = oSheetStyle.Width /100		' unit : 1/100 mm
			oDisp = "[ Page Size in Calc ]" & Chr$(10) & _
						"Heihgt		:	" & Int(oPageH) & " mm " & Chr$(10) & _
						"Width		:	" & Int(oPageW) & " mm "
		msgbox(oDisp,0,"Sheet") 	
End Sub

CS-)[Calc]上下左右余白取得



Sub oSheet
	Dim oDoc
	Dim oSheet
	Dim oPageStyle
		oDoc = ThisComponent
			oSheet = oDoc.CurrentController.getActiveSheet()
			oSheetStyle	= oSheet.PageStyle
				oSheetStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oSheetStyle) 
			oTopMargin = oSheetStyle.TopMargin /100		' unit : 1/100 mm
			oBottomMargin = oSheetStyle.BottomMargin /100		' unit : 1/100 mm
			oLeftMargin = oSheetStyle.LeftMargin /100		' unit : 1/100 mm
			oRightMargin = oSheetStyle.RightMargin /100		' unit : 1/100 mm
			oDisp = "[ Page Margin in Calc ]" & Chr$(10) & _
						"Top Margin		:	" & Int(oTopMargin) & " mm " & Chr$(10) & _
						"Bottom Margin	:	" & Int(oBottomMargin) & " mm " & Chr$(10) & _
						"Left Margin		:	" & Int(oLeftMargin) & " mm " & Chr$(10) & _
						"Right Margin		:	" & Int(oRightMargin) & " mm "
		msgbox(oDisp,0,"Sheet") 	
End Sub

CS-)[Calc]余白設定



Sub CalcPageStyle()
	Dim oDoc
	Dim oSheet
	Dim oPageStyle
		oDoc = ThisComponent
			oSheet = oDoc.CurrentController.getActiveSheet()
			oSheetStyle	= oSheet.PageStyle
				oSheetStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oSheetStyle) 
			'Pre Margin
				oPreTopMargin = oSheetStyle.TopMargin /100		' unit : 1/100 mm
			'Margin Set
				oSheetStyle.TopMargin = 15*100
			'Confirm
				oTopMargin = oSheetStyle.TopMargin /100		' unit : 1/100 mm
					oDisp = "[ Page Margin set ]" & Chr$(10) & _
						"Top Margin : " & Int(oPreTopMargin) & " mm   =>  " & Int(oTopMargin) & " mm "
		msgbox(oDisp,0,"Sheet") 	
End Sub

CS-)[Calc]Page StylのDialog表示



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

CS-)[Calc]行と列のFontName(英数字、日本語)設定。


Sub oFontsName
Dim oDoc As Object
	oDoc=ThisComponent
	oDoc.Sheets(0).Rows(0).CharFontName = "Courier"
	oDoc.Sheets(0).Rows(0).CharFontNameAsian = "HGP行書体"
	oDoc.Sheets(0).Columns(0).CharFontName = "Arial Black"
	oDoc.Sheets(0).Columns(0).CharFontNameAsian = "HGS明朝"
End Sub

CS-)[Calc]行と列のFontStyle設定。


Sub oCellStyle
Dim oDoc As Object
	oDoc=ThisComponent
	oDoc.Sheets(0).Rows(0).CharFontStyle = "Heading" 'Heading:太字斜体"
	oDoc.Sheets(0).Columns(0).CellStyle = "Heading"
End Sub

CS-)[Calc]ActiveSheetを変更1



Sub ChangeActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oSheets as Object
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		'
		' Get Name of Current Sheet
		oShtName1 = oCntrl.getActiveSheet().Name
		'
		oSheets = oDoc.getSheets()
  		oCntrl.setActiveSheet(oSheets.getByName("Sheet1"))
		'
		oShtName2 = oCntrl.getActiveSheet().Name
		oDisp = "[ Change active sheet ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Active Sheetの変更")
End Sub

CS-)[Calc]ActiveSheetを変更2



Sub ChangeActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Get Name of Current Sheet
		oShtName1 = oCntrl.getActiveSheet().Name
			'
			oProp(0).Name = "Nr"
			oProp(0).Value = 3 				' Sheet3 / not 2 
			'
			'以下での指定は不可
			' oProp(0).Name = "aTableName"
			' oProp(0).Value = "Sheet3"
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToTable", "", 0, oProp())	
		'
		oShtName2 = oCntrl.getActiveSheet().Name
		oDisp = "[ Change active sheet ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Active Sheetの変更")
End Sub

CS-)[Calc]ActiveSheetを変更3



Sub ChangeActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Get Name of Current Sheet
		oShtName1 = oCntrl.getActiveSheet().Name
			'
			oProp(0).Name = "Tables"
			oProp(0).Value = Array(2)		' Sheet3 
		oDispatcher.executeDispatch( oFrame, ".uno:SelectTables", "", 0, oProp())	
		'
		oShtName2 = oCntrl.getActiveSheet().Name
		oDisp = "[ Change active sheet(3) ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Active Sheetの変更")
End Sub

CS-)[Calc]ActiveSheetを変更4a[ Next Sheet ]



Sub ChageActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Get Name of Current Sheet / must be selected sheet1 ( Sheet1をActive Sheetにしておく事 )
		oShtName1 = oCntrl.getActiveSheet().Name
		' Sheet1 → Sheet2
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToNextTable", "", 0, Array())
		' Sheet2 → Sheet3
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToNextTable", "", 0, Array())
		oShtName2 = oCntrl.getActiveSheet().Name
		'
		oDisp = "[ Move next sheet ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Ctrl + PageDown")
End Sub
'
' [ Note ]
' 次のSheetが無い場合(sheet3がCurrnet Sheetの場合)、変化無し。/ Sheet1に戻る訳では無い

CS-)[Calc]ActiveSheetを変更4b[ Previosu Sheet ]



Sub ChangeActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Get Name of Current Sheet / must be selected sheet3 ( Sheet3をActive Sheetにしておく事 )
		oShtName1 = oCntrl.getActiveSheet().Name
		' Sheet3 → Sheet2
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToPrevTable", "", 0, Array())
		' Sheet2 → Sheet1
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToPrevTable", "", 0, Array())
		oShtName2 = oCntrl.getActiveSheet().Name
		'
		oDisp = "[ Move previous sheet ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Ctrl + PageUp")
End Sub
'
' [ Note ]
' 前のSheetが無い場合(sheet1がCurrnet Sheetの場合)、変化無し。/ Sheet3には移らない。

CS-)[Calc]ActiveSheetを追加選択[ Previosu Sheet ]( Ctrl + PageUp )



Sub ChageActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Get Name of Current Sheet / must be selected sheet1 ( Sheet1をActive Sheetにしておく事 )
		oShtName1 = oCntrl.getActiveSheet().Name
		' Sheet1 → Sheet2
		oProp(0).Name = "Sel"
		oProp(0).Value = true
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToNextTableSel", "", 0, Array())
		' Sheet2 → Sheet3
		oProp(0).Name = "Sel"
		oProp(0).Value = true
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToNextTableSel", "", 0, Array())
		oShtName2 = oCntrl.getActiveSheet().Name
		'
		oDisp = "[ Move next sheet ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Ctrl + Shift + PageDown")
End Sub
'
' [ Note ]
' 1) IDE からの実行では追加選択されない。(JumpToNextTable と同じ結果になる)
' 2) 次のSheetが無い場合(sheet3がCurrnet Sheetの場合)、変化無し。/ Sheet1の選択は解除されない。

CS-)[Calc]ActiveSheetを追加選択[ Previosu Sheet ]( Ctrl + PageUp )



Sub ChageActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oShtName1 as String, oShtName2 as String
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Get Name of Current Sheet / must be selected sheet1 ( Sheet1をActive Sheetにしておく事 )
		oShtName1 = oCntrl.getActiveSheet().Name
		' Sheet1 → Sheet2
		oProp(0).Name = "Sel"
		oProp(0).Value = true
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToPrevTableSel", "", 0, Array())
		' Sheet2 → Sheet3
		oProp(0).Name = "Sel"
		oProp(0).Value = true
		oDispatcher.executeDispatch( oFrame, ".uno:JumpToPrevTableSel", "", 0, Array())
		oShtName2 = oCntrl.getActiveSheet().Name
		'
		oDisp = "[ Move next sheet ]" & Chr$(10) & "Before : " & oShtName1 & Chr$(10) & "After : " & oShtName2
		'
		msgbox(oDisp,0,"Ctrl + Shift + PageUp")
End Sub
'
' [ Note ]
' 1) IDE からの実行では追加選択されない。(JumpToPrevTable と同じ結果になる)
' 2) 前のSheetが無い場合(sheet3がCurrnet Sheetの場合)、変化無し。/ Sheet3の選択は解除されない。

CS-)[Calc]複数のSheetを選択



Sub ChangeActSheet()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "Tables"
		oProp(0).Value = Array(0,2)		' Sheet1 and Sheet3 選択 
		oDispatcher.executeDispatch( oFrame, ".uno:SelectTables", "", 0, oProp())	
		'
		msgbox "Success",0,"複数のSheet選択"
End Sub

CS-)[Calc]全Sheetを選択



Sub CalcValidation()
    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:TableSelectAll", "", 0, Array())
		'
		msgbox "Success"
End Sub

CS-)[Calc]別のドキュメントから持ってきたsheetを挿入する。


Sub main
Dim oDoc As Object, oSheets As Object
Dim sSheetName As String
Dim oNewSheet As Object
  sSheetName = "NewSheet2"
  oDoc = ThisComponent 'calc doc
  oSheets = oDoc.getSheets()
  oNewSheet = oDoc.createInstance( "com.sun.star.sheet.Spreadsheet" )	'←新規追加に比べて本行を追加
  If NOT oSheets.hasByName( sSheetName ) Then
    oSheets.insertByName( sSheetName, oNewSheet )						'←「0」⇒「oNewSheet」に置換
  End If
End Sub

CS-)[Calc]Sheet枚数取得


Sub oSheetSpreadsheets
	Dim oDoc
		oDoc = ThisComponent
		oSheets= oDoc.Sheets
		oNum = oSheets.getCount()
		oDisp = "Sheet枚数 => " & oNum 
		msgbox(oDisp,0,"Sheet枚数取得")
End Sub

CS-)[Calc]Document内にSheetがあるか


Sub oSheetSpreadsheets
	Dim oDoc
		oDoc = ThisComponent
		oSheets= oDoc.Sheets
		oDisp=oSheets.hasElements()
		msgbox(oDisp,0,"com.sun.star.sheet.Spreadsheets")
End Sub

CS-)[Calc]Document内にSheet名一覧


Sub oSheetSpreadsheets
	Dim oDoc
		oDoc = ThisComponent
		oSheets= oDoc.Sheets
		oSEnum=oSheets.createEnumeration()
		Do While oSEnum.hasMoreElements()
			oSheet = oSEnum.nextElement()
			oDisp = oDisp & oSheet.Name & Chr$(10)
		Loop 
		msgbox(oDisp,0,"com.sun.star.sheet.Spreadsheets")
End Sub

CS-)[Calc]Page Style Dialogの表示



Sub PageFormat()
	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:PageFormatDialog", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CS-)[Calc]Sheet Themaの選択Dialog表示



Sub CalcSheetThema()
	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:ChooseDesign", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' Themaについては LibreOffice Help参照

CS-)[Calc]

[ Link ]

CS-18)[Calc]SheetのLink1


Sub Main
 oNewDoc = StarDesktop.loadComponentFromURL( _
    "private:factory/scalc", "_blank", 0, Array() )
 
 oNSheets = oNewDoc.getSheets()
 oNSheet = oNSheets.getByIndex(0)
 
 ' add link
 oNSheet.link( _
     "/home/name/Desktop/LinkTest.ods", _
     "Sheet1", _
     "", _
     "", _
     com.sun.star.sheet.SheetLinkMode.NORMAL )

 ' remove link
 oNSheet.setLinkMode(_
   com.sun.star.sheet.SheetLinkMode.NONE )
End Sub

CSL-)[Calc]SheetのLink2


Sub oLinkSheet
	Dim ovalSheets
	Dim oSheet
	Dim oSheetEnum
	Dim oLURL as String
		oFile = "C:\temp\oAuthor.ods"
		oLURL = ConvertToUrl(oFile)
		'oLURL = "oAuthor.ods"
		oDoc = ThisComponent
		ovalSheets = oDoc.Sheets()		'The Sheets object that contains all of the sheets
		oLSheet = "oLinktest"
   		If ovalSheets.hasByName( oLSheet ) Then
			oSheet = oDoc.getSheets().getByName(oLSheet)
			oLink = oSheet.link(oLURL, "Sheet1","","",com.sun.star.sheet.SheetLinkMode.NORMAL)
				document   = oDoc.CurrentController.Frame
				dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
					dispatcher.executeDispatch(document, ".uno:Refresh", "", 0, Array())
			Msgbox("Current Frame is refreshed!!",0,"Case1 : " & oLSheet & " was Linked already")
			Exit Sub 
		End If
		ovalSheets.insertNewByName("test", ovalSheets.getCount())
		oSheet = ovalSheet.getByName(oLSheet)
		oSheet.link(oLURL, "Sheet1","","",com.sun.star.sheet.SheetLinkMode.NORMAL)
End Sub

CSL-)[Calc]別fileのCellとLink


Sub oCellLink
	Dim oSheet
	Dim oCell
		oSheet = ThisComponent.Sheets(0)
		oCell = oSheet.getCellByposition(0,0)		'	A1
		oCell.setFormula("=" & "'file:///C:/temp/oAuthor.ods'#Sheet1.A2") 
End Sub

[ Sheet Cursors ]

CSC-)[Calc]Active Cellの移動(1)



Sub oCursor
	Dim oCurs
	Dim oSheet
		oDoc = THisComponent
		oSheet = oDoc.Sheets(1)	
		oCurs = oSheet.createCursorByRange(oSheet.getCellByPosition(0,0))
		'Start Address
			oldActiveColumn=oCurs.getRangeAddress.StartColumn
			oldActiveRow=oCurs.getRangeAddress.StartRow
				oDisp = "[ Sheet Cursor ]" & Chr$(10)
					oDisp = oDisp & "< Start Address >" & Chr$(10)
					oDisp = oDisp & "(  " & oldActiveColumn & " , " & oldActiveRow & " )"  & Chr$(10)
		'move right cell
			oCurs.gotoNext()
			oActiveColumn=oCurs.getRangeAddress.StartColumn
			oActiveRow=oCurs.getRangeAddress.StartRow
				oDisp = oDisp & Chr$(9) & " => " & Chr$(10)
					oDisp = oDisp & "" & Chr$(10)
					oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
		'move End cell
			oCurs.gotoEnd()
			oActiveColumn=oCurs.getRangeAddress.StartColumn
			oActiveRow=oCurs.getRangeAddress.StartRow
				oDisp = oDisp & Chr$(9) &  " => " & Chr$(10)
					oDisp = oDisp & "" & Chr$(10)
					oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10) 
		'move Left Cell
			oCurs.gotoPrevious()
			oActiveColumn=oCurs.getRangeAddress.StartColumn
			oActiveRow=oCurs.getRangeAddress.StartRow
				oDisp = oDisp & Chr$(9) &  " => " & Chr$(10)
					oDisp = oDisp & "" & Chr$(10)
					oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
		'Offset Cell
			oCurs.gotoOffset(-3,-5)
			oActiveColumn=oCurs.getRangeAddress.StartColumn
			oActiveRow=oCurs.getRangeAddress.StartRow
				oDisp = oDisp & Chr$(9) &  " => " & Chr$(10)
					oDisp = oDisp & "" & Chr$(10)
					oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
	'Display
		msgbox(oDisp, 0, "com.sun.star.sheet.SheetCellCursor Service")
End Sub

CSC-)[Calc]Active Cellの移動(2)



Sub SheetCursor()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCursor as Object
	Dim oShtEndCol as Long, oShtEndRow as Long
	Dim oShtStartCol as Long, oShtShartRow as Long
	Dim oShtOftCol as Long, oShtOftRow as Long
	Dim oShtNextCol as Long, oShtNextRow as Long
	Dim oShtPrevCol as Long, oShtPrevRow as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCursor = oSheet.createCursor()
		'
		oDisp = "[ Simple Cursor movement(2) ]" & Chr$(10)
		'
		oCursor.gotoStart()		' Dataが無いって無い場合は gotoStart は機能しない???
		oShtStartCol = oCursor.getRangeAddress().EndColumn			' 1つのCellしか選択しないので EndColumn でも同じ
		oShtStartRow  = oCursor.getRangeAddress().EndRow
		oDisp = oDisp & "Column of start cell = " & oShtStartCol & Chr$(10) & "Row of start cell = " & oShtStartRow & Chr$(10) & Chr$(10)
		'
		oCursor.gotoEnd()
		oShtEndCol = oCursor.getRangeAddress().EndColumn			' 1つのCellしか選択しないので StartColumn でも同じ
		oShtEndRow  = oCursor.getRangeAddress().EndRow
		oDisp = oDisp & "Column of end cell = " & oShtEndCol & Chr$(10) & "Row of end cell = " & oShtEndRow & Chr$(10) & Chr$(10)
		'
		oCursor.gotoOffset(-2,-2)
		oShtOftCol = oCursor.getRangeAddress().StartColumn			' 1つのCellしか選択しないので EndColumn でも同じ
		oShtOftRow  = oCursor.getRangeAddress().StartRow
		oDisp = oDisp & "Column of offset( -2, -2 ) = " & oShtOftCol & Chr$(10) & "Row of end offset( -2, -2 ) = " & oShtOftRow & Chr$(10) & Chr$(10)
		'
		oCursor.gotoNext()
		oShtNextCol = oCursor.getRangeAddress().EndColumn	
		oShtNextRow  = oCursor.getRangeAddress().EndRow
		oDisp = oDisp & "Column of next cell = " & oShtNextCol & Chr$(10) & "Row of next cell = " & oShtNextRow & Chr$(10) & Chr$(10)
		'
		oCursor.gotoPrevious()
		oShtPrevCol = oCursor.getRangeAddress().StartColumn	
		oShtPrevRow  = oCursor.getRangeAddress().StartRow
		oDisp = oDisp & "Column of next cell = " & oShtPrevCol & Chr$(10) & "Row of next cell = " & oShtPrevRow & Chr$(10) & Chr$(10)
		'
		msgbox(oDisp,0,"createCursor")
End Sub

CSC-)[Calc]Active Cellの移動(3)



Sub oCursor()
	Dim oDoc as Object, oCtrl as Object
	Dim oSel as Object 
	Dim oCurs as Object
	Dim oldActiveColumn as Long, oldActiveRow as Long
	Dim oActiveColumn as Long, oActiveRow as Long
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		'Start Address
			oSel = oCtrl.getSelection()
			oldActiveColumn = oSel.getCellAddress.Column
			oldActiveRow = oSel.getCellAddress.Row
				oDisp = "[ Sheet Cursor ]" & Chr$(10)
					oDisp = oDisp & "\\\ Start Address \\\" & Chr$(10)
					oDisp = oDisp & "(  " & oldActiveColumn & " , " & oldActiveRow & " )"  & Chr$(10)
					'
		'move right  7 cell
		oProp(0).Name = "By"		' Writerでは 無意味
		oProp(0).Value = 7
		oDispatcher.executeDispatch(oFrame,  ".uno:GoRight", "", 0, oProp())
			oSel = oCtrl.getSelection()
			oActiveColumn = oSel.getCellAddress.Column
			oActiveRow = oSel.getCellAddress.Row
			oDisp = oDisp & Chr$(9) & " ↓ "
			oDisp = oDisp & "" & Chr$(10)
			oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
		'move Down 5 cell
		oProp(0).Name = "By"		' Writerでは 無意味
		oProp(0).Value = 5
		oDispatcher.executeDispatch(oFrame,  ".uno:GoDown", "", 0, oProp())
			oSel = oCtrl.getSelection()
			oActiveColumn = oSel.getCellAddress.Column
			oActiveRow = oSel.getCellAddress.Row
			oDisp = oDisp & Chr$(9) & " ↓ "
			oDisp = oDisp & "" & Chr$(10)
			oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
		'move Left 3 cell
		oProp(0).Name = "By"		' Writerでは 無意味
		oProp(0).Value = 3
		oDispatcher.executeDispatch(oFrame,  ".uno:GoLeft", "", 0, oProp())		' 1 time
			oSel = oCtrl.getSelection()
			oActiveColumn = oSel.getCellAddress.Column
			oActiveRow = oSel.getCellAddress.Row
			oDisp = oDisp & Chr$(9) & " ↓ "
			oDisp = oDisp & "" & Chr$(10)
			oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
		'move Up 2 cell
		oProp(0).Name = "By"		' Writerでは 無意味
		oProp(0).Value = 2
		oDispatcher.executeDispatch(oFrame,  ".uno:GoUp", "", 0, oProp())		' 1 time
			oSel = oCtrl.getSelection()
			oActiveColumn = oSel.getCellAddress.Column
			oActiveRow = oSel.getCellAddress.Row
			oDisp = oDisp & Chr$(9) & " ↓ "
			oDisp = oDisp & "" & Chr$(10)
			oDisp = oDisp & "(  " & oActiveColumn & " , " & oActiveRow & " )"  & Chr$(10)
	'Display
		msgbox(oDisp, 0, "Cell移動")
End Sub

CSC-)[Calc]Selected Cellを識別( One Cell or One Area or Multi Area )



Sub oCalcIsAnythingSelected()
	Dim oDoc as Object
	Dim oSelection as Object
	Dim oImpName as String
	Dim oDisp as String
	Dim oCount as Long
		oDoc = ThisComponent
		If IsNull(oDoc) then Exit Sub
		'
		oSelection = oDoc.getCurrentSelection()
		oDisp = "[ 現在選択されているCellについて ]" & Chr$(10) & Chr$(10)
		If oSelection.supportsService("com.sun.star.sheet.SheetCell") then
			' Selected only one Cell
			oImpName = oSelection.getImplementationName()
			oDisp = oDisp & "One Cell Selected !!" & Chr$(10) & "ImplementationName = " & oImpName & Chr$(10) & _
							"String : " & oString & Chr$(10)
		ElseIf oSelection.supportsService("com.sun.star.sheet.SheetCellRange") then
			' Selected only one area
			oImpName = oSelection.getImplementationName()
			oDisp = oDisp & "One Cell Range Selected !!" & Chr$(10) & "ImplementationName = "  & oImpName
		ElseIf oSelection.supportsService("com.sun.star.sheet.SheetCellRanges") then
			' Selected some area
			oImpName = oSelection.getImplementationName()
			oCount = oSelection.getCount()
			oDisp = oDisp & "Multiple Cell Range Selected !!" & Chr$(10) & "ImplementationName = "  & oImpName & Chr$(10) & _
							"Count : " & oCount
		Else
			oImpName = oSelection.getImplementationName()
			Disp = oDisp & "Something else Selected : " & oImpName
		End If		
		msgbox(oDisp,0,"Is Calc anything select? ")
End Sub

CS-)[Calc]空白で無い次のData Cell( or Area Dataの端Cell )へ移動( Ctrl + ↑ / Ctrl + ↓ / Ctrl + → / Ctrl + ← )



Sub oCntrlArrow()
	Dim oDoc as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(1) as new com.sun.star.beans.PropertyValue
	Dim oColAddr1 as Long, oRowAddr1 as Long, oColAddr2 as Long, oRowAddr2 as Long
	Dim oColAddr3 as Long, oRowAddr3 as Long, oColAddr4 as Long, oRowAddr4 as Long, oColAddr5 as Long, oRowAddr5 as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDisp = "[ Cntrl + ↓ / → / ↑ / ← ]" & Chr$(10)
		'
		oColAddr1 = oCntrl.getSelection().getRangeAddress().EndColumn 
		oRowAddr1 = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oProp(0).Name = "By"
		oProp(0).Value = 1
		oProp(1).Name = "Sel"
		oProp(1).Value = false			' 移動先のCellを 選択( false ) / true : 選択しない( Activateのみ )
		oDispatcher.executeDispatch( oFrame, ".uno:GoDownToEndOfData", "", 0, oProp())
		oColAddr2 = oCntrl.getSelection().getRangeAddress().EndColumn 
		oRowAddr2 = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oProp(0).Name = "By"
		oProp(0).Value = 1
		oProp(1).Name = "Sel"
		oProp(1).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:GoDownToEndOfData", "", 0, oProp())
		oColAddr3 = oCntrl.getSelection().getRangeAddress().EndColumn 
		oRowAddr3 = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oProp(0).Name = "By"
		oProp(0).Value = 1
		oProp(1).Name = "Sel"
		oProp(1).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:GoRightToEndOfData", "", 0, oProp())
		oColAddr4 = oCntrl.getSelection().getRangeAddress().EndColumn 
		oRowAddr4 = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oProp(0).Name = "By"
		oProp(0).Value = 1
		oProp(1).Name = "Sel"
		oProp(1).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:GoUpToStartOfData", "", 0, oProp())
		oColAddr5 = oCntrl.getSelection().getRangeAddress().EndColumn 
		oRowAddr5 = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oProp(0).Name = "By"
		oProp(0).Value = 1
		oProp(1).Name = "Sel"
		oProp(1).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:GoLeftToStartOfData", "", 0, oProp())
		oColAddr6 = oCntrl.getSelection().getRangeAddress().EndColumn 
		oRowAddr6 = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oDisp = oDisp & "( " & oColAddr1 & " , " & oRowAddr1 & " ) " & Chr$(9) & "←" & Chr$(9) & _
				"( " & oColAddr5 & " , " & oRowAddr5 & " ) " & Chr$(10) & Chr$(9) & "↓" & Chr$(10) & _
				"( " & oColAddr2 & " , " & oRowAddr2 & " ) " & Chr$(9) & Chr$(9) & Chr$(9) & "↑" & Chr$(10) & Chr$(9) & "↓" & Chr$(10) & _ 
				"( " & oColAddr3 & " , " & oRowAddr3 & " ) " & Chr$(9) & "→" & Chr$(9) & "( " & oColAddr4 & " , " & oRowAddr4 & " ) "
				'
		if oColAddr1 = oColAddr6 and oRowAddr1 = oRowAddr6 then
			oDisp = oDisp & Chr$(10) & Chr$(10) & "Active Cell is Cylced !!"
		else
			oDisp = oDisp & Chr$(10) & Chr(10) & "Active Cell is not Cylced !!" & Chr$(10) & "Final Cell = " & "( " & oColAddr6 & " , " & oRowAddr6 & " ) "
		end if
		'
		msgbox(oDisp,0,"Ctrl + Arrow")
End Sub

CSC-)[Calc]Ctrl + End / 入力されているDataの最終Colmn, Rowへ移動・選択



Sub CellSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatch as Object
	Dim oProp() as new com.sun.star.beans.PropertyValue
	Dim oSel as Object, oAddr as Object, oCol as Long, oRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatch.executeDispatch(oFrame, ".uno:GoToEndOfData", "", 0, oProp())
		oSel = oDoc.getCurrentSelection() 
		'
		oAddr = oSel.getCellAddress()	' ← Refer to Note 3)
		oCol = oAddr.Column
		oRow = oAddr.Row
		oDisp = "[ .uno:GoToEndOfData ]" & Chr$(10) & "Col = " & oCol & Chr$(10) & "Row = " & oRow 
		msgbox oDisp, 0, "GoToEndOfData"
End Sub
'
' [ Note ]
' 1)  .uno:GoToStartOfData は無い
' 2) oDoc.getCurrentSelection() = oDoc.getCurrentContoller().getSelection()
' 3) End Cell( 1 Cell )を選択するので getRangeAddressは不可
' 4) Calc以外ではDocumentの末尾へ

CSC-)[Calc]Ctrl + Home / A1 Cellへ移動･選択



Sub CellSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatch as Object
	Dim oProp() as new com.sun.star.beans.PropertyValue
	Dim oSel as Object, oAddr as Object, oCol as Long, oRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Ctrl + Home
		oDispatch.executeDispatch(oFrame, ".uno:GoToStart", "", 0, oProp())
		'
		oSel = oDoc.getCurrentSelection()
		oAddr = oSel.getCellAddress()
		oCol = oAddr.Column
		oRow = oAddr.Row
		oDisp = "[ .uno:GoToStart ]" & Chr$(10) & Chr$(10) & _
					"Col = " & oCol & Chr$(10) & "Row = " & oRow
		'
	msgbox oDisp, 0, "GoToStart "
End Sub
'
' [ Note ]
' 1)  .uno:GoToEnd は無い
' 2) oDoc.getCurrentSelection() = oDoc.getCurrentContoller().getSelection()
' 3) A1 Cell( 1 Cell )を選択するので getRangeAddressは不可
' 4) Calc以外ではDocumentの先頭へ

CSC-)[Calc]相対AddressでCurosor Cell/Range指定



Sub ShtCellCuror()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oCellAddr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("C3:K10")
		'
		oCursor = oSheet.createCursorByRange(oRange)
		'
		' oCursor Objectにおける相対Addressの取得
		oRtvCell = oCursor.getCellByPosition(0, 0)		' C3 = (2,2)
		oCellAddr = oRtvCell.getRangeAddress()
		oDisp = "[ com.sun.star.sheet.SheetCellCursor ]" & Chr$(10) & "( 0 ,0 ) → ( " & _
				oCellAddr.StartColumn & " , " & oCellAddr.StartRow & " )～( " & _
				oCellAddr.EndColumn & " , " & oCellAddr.EndRow & " )"
				'
		oRtvCell = oCursor.getCellRangeByPosition(1,1,3,3)		' C3 = (2,2) → (2+1,2+1,2+3,2+3) = (3,3,5,5) = (3,3)～(5,5) = (D4:F6)
		oCellAddr = oRtvCell.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "( 1,1,3,3 ) → ( " & _
				oCellAddr.StartColumn & " , " & oCellAddr.StartRow & " )～( " & _
				oCellAddr.EndColumn & " , " & oCellAddr.EndRow & " )"
				'
		oRtvCell = oCursor.getCellRangeByName("D4:F6")		' ( D4:F6) = (3,3)～(5,5)
		oCellAddr = oRtvCell.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "( ""D4:F6"" ) → ( " & _
				oCellAddr.StartColumn & " , " & oCellAddr.StartRow & " )～( " & _
				oCellAddr.EndColumn & " , " & oCellAddr.EndRow & " )"
				'
		oIsError = IsRngErr("D4:M12")			' 範囲（C3:K10） 以上の範囲を指定するとError
		oDisp = oDisp & Chr$(10) & "( ""D4:M12"" ) は Error → " & oIsError
				
		msgbox oDisp,0,"Relative Address"
End Sub
'
Function IsRngErr(oRange as String) as Boolean
	On Error Goto oBad
	oCursor.getCellRangeByName(oRange)
	IsRngErr = false
	Exit Function
oBad:
	IsRngErr = true
End Function
'
' [ Note ]
' com.sun.star.sheet.SheetCellCursor は Cell の値はReturnしない。つまり
' oRtvCell = oCursor.getCellByPosition(0, 0).Value としても Cell の値は取得不可である。

CSC-)[Calc]Cursor範囲の拡大



Sub ExpandCurorRegion()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oSelection as Object
	Dim oCursor as Object
	Dim oRngAddr1 as Object, RngAddr2 as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 0 to 5
				oCell = oSheet.getCellByPosition( i, k )
				if k = 4 or k = 5 then
					if i = 1 then
						' Empty
					else
						if i = 2 or i = 3 then
							' Empty
						else
							oCell.String = CStr("A" & i + k)
						end if
					end if
				else
					oCell.String = CStr( i * k )
				end if
			next k
		next i
		oCell = oSheet.getCellByPosition( 5, 6 )		' 連続Dataから外れているので、範囲に含まれない
		oCell.String = "Test"
		'
		oSelection = oSheet.getCellRangeByName("C3")
		oCursor = oSheet.createCursorByRange( oSelection )
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = "[ SheetCellCursor範囲の拡大 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' Dataが途切れる範囲まで拡大
		oCursor.collapseToCurrentRegion()
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
		msgbox oDisp,0,"Expand Range"
End Sub

CSC-)[Calc]Cursor範囲の拡大( Array Formula )



Sub CalcArrayFormula()
	Dim oDoc as Object, oSheet as Object, oCell as Object 
	Dim oRange as Object
	Dim oSelection as Object, oCursor as Object
	Dim oRngAddr1 as Object, oRngAddr2 as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
	'Set the two top cells
		oCell = oSheet.getCellByPosition(1,2)
			oCell.setValue(1)
		oCell = oSheet.getCellByPosition(2,2)
			oCell.setValue(3)
	'Fill the Values Down
		oRange = oSheet.getCellRangeByName("B3:C8")
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
	'Setting each cell individually
		for i=3 to 8
			oCell = oSheet.getCellByPosition(3, i-1)
			oCell.setFormula("=B" & i & "+C" & i)
		next i
	'Setting a single array formula
		oRange = oSheet.getCellRangeByName("E3:E8")
		oRange.setArrayFormula("=B3:B8+C3:C8")
	'Title for Column
		oRange = oSheet.getCellRangeByName("B2:E2")
		oRange.setDataArray(Array(Array("B", "C", "Formula", "Array Formula")))
		'
	' Array Formula範囲以外のCursorの場合
		oSelection = oSheet.getCellRangeByName("D4")
		oCursor = oSheet.createCursorByRange( oSelection )
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = "[ Array Formula範囲以外 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' Array Formula範囲の拡大
		oCursor.collapseToCurrentArray()
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
	' Array Formula範囲のCursorの場合
		oSelection = oSheet.getCellRangeByName("E4")
		oCursor = oSheet.createCursorByRange( oSelection )
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = oDisp & Chr$(10) & Chr$(10) & "[ Array Formula範囲 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' Array Formula範囲の拡大
		oCursor.collapseToCurrentArray()
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
		msgbox oDisp,0,"collapseToCurrentArray"
End Sub

CSC-)[Calc]Cursor範囲の拡大( Merge Area )



Sub CalcExpandMergeArea()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oSelection as Object, oCursor as Object
	Dim oRngAddr1 as Object, oRngAddr2 as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("A1:B2")
		'
		oRange.merge(true)
		'
		oSelection = oSheet.getCellRangeByName("A1")
		oCursor = oSheet.createCursorByRange( oSelection )
		'
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = "[ SheetCellCursor範囲の拡大 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' Merge範囲まで拡大
		oCursor.collapseToMergedArea()
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
		msgbox oDisp,0,"collapseToMergedArea"
End Sub

CSC-)[Calc]Cursor範囲の拡大( Max row of same column )



Sub ExpandCurorRegion()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oSelection as Object
	Dim oCursor as Object
	Dim oRngAddr1 as Object, RngAddr2 as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 0 to 5
				oCell = oSheet.getCellByPosition( i, k )
				if k = 4 or k = 5 then
					if i = 1 then
						' Empty
					else
						if i = 2 or i = 3 then
							' Empty
						else
							oCell.String = CStr("A" & i + k)
						end if
					end if
				else
					oCell.String = CStr( i * k )
				end if
			next k
		next i
		'
		oSelection = oSheet.getCellRangeByName("C3")
		oCursor = oSheet.createCursorByRange( oSelection )
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = "[ SheetCellCursor範囲の拡大 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' 最大行まで範囲拡大
		oCursor.expandToEntireColumns()
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
		msgbox oDisp,0,"expandToEntireColumns"
End Sub

CSC-)[Calc]Cursor範囲の拡大( Max column of same row )



Sub ExpandCurorRegion()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oSelection as Object
	Dim oCursor as Object
	Dim oRngAddr1 as Object, RngAddr2 as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 0 to 5
				oCell = oSheet.getCellByPosition( i, k )
				if k = 4 or k = 5 then
					if i = 1 then
						' Empty
					else
						if i = 2 or i = 3 then
							' Empty
						else
							oCell.String = CStr("A" & i + k)
						end if
					end if
				else
					oCell.String = CStr( i * k )
				end if
			next k
		next i
		'
		oSelection = oSheet.getCellRangeByName("C3")
		oCursor = oSheet.createCursorByRange( oSelection )
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = "[ SheetCellCursor範囲の拡大 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' 最大列まで範囲拡大
		oCursor.expandToEntireRows()
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
		msgbox oDisp,0,"expandToEntireRows"
End Sub

CSC-)[Calc]Curosr範囲の拡大( 任意の位置( same with upper-left ) )



Sub ExpandCurorRegion()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oSelection as Object
	Dim oCursor as Object
	Dim oRngAddr1 as Object, RngAddr2 as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 0 to 5
				oCell = oSheet.getCellByPosition( i, k )
				if k = 4 or k = 5 then
					if i = 1 then
						' Empty
					else
						if i = 2 or i = 3 then
							' Empty
						else
							oCell.String = CStr("A" & i + k)
						end if
					end if
				else
					oCell.String = CStr( i * k )
				end if
			next k
		next i
		'
		oSelection = oSheet.getCellRangeByName("C3")
		oCursor = oSheet.createCursorByRange( oSelection )
		' Before
		oRngAddr1 = oCursor.getRangeAddress()
		oDisp = "[ SheetCellCursor範囲の拡大 ]" & Chr$(10) & "[ Before ]" & Chr$(10) & _
				"( " & oRngAddr1.StartColumn & " , " & oRngAddr1.StartRow & " )～( " & _
				oRngAddr1.EndColumn & " ," & oRngAddr1.EndRow & " )" & Chr$(10)
		'
		' 任意の位置まで範囲拡大
		oCursor.collapseToSize(100,100)	' ← 列、行共に +1 まで拡大
		'
		' After
		oRngAddr2 = oCursor.getRangeAddress()
		oDisp = oDisp & Chr$(10) & "[ After ]" & Chr$(10) & _
				"( " & oRngAddr2.StartColumn & " , " & oRngAddr2.StartRow & " )～( " & _
				oRngAddr2.EndColumn & " ," & oRngAddr2.EndRow & " )"
				'
		msgbox oDisp,0,"collapseToSize"
End Sub

CSC-)[Calc]任意の範囲内のCuosor移動



Sub ExpandCurorRegion()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oSelection as Object
	Dim oCursor as Object
	Dim oRngAddr1 as Object, RngAddr2 as Object
	Dim oCellRangeAddr as Object
	Dim oDisp as String
	Dim oCurRngAddr as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 1 to 5
				oCell = oSheet.getCellByPosition( i, k )
				if k = 4 or k = 5 then
					if i = 1 then
						' Empty
					else
						if i = 2 or i = 3 then
						  ' Empty
						else
						  oCell.String = CStr("A" & i + k)
						end if
					end if
				else
					if k = 1 and i = 0 then
					  ' Empty
					else
					  oCell.String = CStr( i * k )
					end if
				end if
			next k
		next i
		oCell = oSheet.getCellByPosition( 5, 6 )
		oCell.String = "Test"
		'
		oSelection = oSheet.getCellRangeByName("C3")
		oCursor = oSheet.createCursorByRange( oSelection )
		oCellRangeAddr = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
		oCellRangeAddr.InsertByName( "", oCursor )
		oCurRngAddr = oCellRangeAddr.getRangeAddressesAsString()
		oDisp = "[ Cursoｒ Rangeの取得 ]" & Chr$(10) & "Fisrst →  " & oCurRngAddr & Chr$(10)
		'
		' Sheet中のCursor RangeのFirst Data Cell へ移動
		oCursor.gotoStartOfUsedArea( false )
		oCellRangeAddr.InsertByName( "Fisrt", oCursor )
		oCurRngAddr = oCellRangeAddr.getRangeAddressesAsString()
  		oDisp = oDisp & Chr$(10) & "Goto Start without Expapnd" & Chr$(10) & " →  " & oCurRngAddr
  		'
  		' Cursor を Sheet中のFirst Data Cell へRangeをひろげながら移動
  		oCursor.gotoEndOfUsedArea( true )
  		'oCellRangeAddress = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
  		oCellRangeAddr.InsertByName( "End", oCursor )
  		oCurRngAddr = oCellRangeAddr.getRangeAddressesAsString()
  		oDisp = oDisp & Chr$(10) & "Goto End with Expand" & Chr$(10) & " →  " & oCurRngAddr
  		'
  		msgbox oDisp,0,"Curorの移動"
End Sub
'
' [ Note ]
' gotoStartOfUsedArea( true or false ) →  true: Curosr範囲を広げる。 / false: Curosr範囲を広げない。
' gotoEndOfUsedArea( true or false ) →  true: Curosr範囲を広げる。 / false: Curosr範囲を広げない。
'
' Name無しのRangeでは.getRangeAddressesAsString() の Return が Empty。InsertByName("",oCursor)でもOK

CSC-)[Calc]Cellの編集Mode中のCursor位置変更


Sub CellSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatch as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oAns as Long,oDisp as String
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatch.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "StringName"
		oProp(0).Value = "LibreOffice 4.2.2"
		oDispatch.executeDispatch(oFrame, ".uno:EnterString", "", 0, oProp())
		'
		' Cellの編集Mode / 文字の末尾でCursor点滅
		oDispatch.executeDispatch(oFrame, ".uno:FocusInputLine", "", 0, Array())
		oDisp = "Cellの編集Modeになりました。 / 文字の末尾でCursor点滅" & Chr$(10) & "文字の先頭にCursorを移動させますか?"
		oAns = msgbox(oDisp, 4, "Curosor位置")
		if oAns = 6 then
			' Cellの編集Mode / CellにCursorを移す
			oDispatch.executeDispatch(oFrame, ".uno:SetInputMode", "", 0, Array())
			'
			' Cellの演習Modeを終了する
			oDisp = "文字の先頭にCursorrが移りました。" & Chr$(10) & "Cell の編集Modeを終了しますか?"
			oAns = msgbox(oDisp, 4, "Curosor位置")
			if oAns = 6 then
				' Cellの編集Mode終了
				oDispatch.executeDispatch(oFrame, ".uno:GoToCurrentCell", "", 0, Array())
			end if	
		end if	
End Sub

CSC-)[Calc]Page Down / Page Up / Page Left / Page Right


Sub CalcSelection()
	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")
	' R10 Cellへ移動
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "R10"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
	' Page Down
		msgbox "R10 Cell !!",0,"表示画面"
		oDispatcher.executeDispatch(oFrame, ".uno:GoDownBlock", "", 0, Array())
		msgbox "Page Down",0,"表示画面"
	' Page Up
		oDispatcher.executeDispatch(oFrame, ".uno:GoUpBlock", "", 0, Array())
		msgbox "Page Up",0,"表示画面"
	' Page Left
		oDispatcher.executeDispatch(oFrame, ".uno:GoLeftBlock", "", 0, Array())
		msgbox "Page Left",0,"表示画面"
	' Page Right
		oDispatcher.executeDispatch(oFrame, ".uno:GoRightBlock", "", 0, Array())
		msgbox "Page Right",0,"表示画面"
End Sub

CSC-)[Calc]

[ Window ]

CSWn-)[Calc]Windowの分割[上下] / 解除(1)


Sub SheetWindow()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$A$7:ANJ$7" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
		msgbox("Window分割 OK",0,"Display")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
		msgbox("Window分割解除 OK",0,"Display")
End Sub

CSWn-)[Calc]Windowの分割[4分割] / 解除(2)


Sub SheetWindow()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$C$7" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
		msgbox("Window分割 OK",0,"Display")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
		msgbox("Window分割解除 OK",0,"Display")
End Sub

CSWn-)[Calc]Windowの分割[4分割] / 解除(3)


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.splitAtPosition(100, 150)		' unit : Pixel  ← Cellの途中でもOK
		msgbox("Window分割 OK",0,"Display")
		'
		oCtrl.splitAtPosition(0, 0)
		msgbox("Window分割解除 OK",0,"Display")
End Sub

CSWn-)[Calc]Windowの分割固定 / 分割解除


Sub SheetWindow()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$C$7" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
		'
		oProp(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue")
		oDispatcher.executeDispatch(oFrame, ".uno:FreezePanes", "", 0, oProp())
		msgbox("Window分割固定 OK",0,"Display")
		'
		oDispatcher.executeDispatch(oFrame, ".uno:FreezePanes", "", 0, oProp())
		msgbox("Window分割解除 OK",0,"Display")
End Sub

CSWn-)[Calc]Windowの分割固定


Sub SheetWindow()
	Dim oDoc as Object
	Dim oCtrl as Object
	Dim oCol as Long, oRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		'
		oCol = 3
		oRow = 7		' ( 3, 7 ) ← D8 Cell
		oCtrl.FreezeAtPosition(oCol , oRow)		' ( Column, Row )
		oDisp = "( Col, Row ) = ( " & oCol & " , " & oRow & "  )の位置で" & Chr$(10) & "固定区切を設定しました。"
		msgbox(oDisp,0,"Split Window")
		'
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:FreezePanes", "", 0, oProp())
		'
		oDisp = "固定区切りを解除しました。"
		msgbox(oDisp,0,"Split Window")
End Sub

CSWn-)[Calc]Windowの分割有無及び分割位置取得(1)[ Address ]


Sub SheetWindow()
	Dim oDoc as Object
	Dim oCtrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oBeforeWin as Boolean
	Dim oSplitCol as Long
	Dim oSplitRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$A$7:ANJ$7" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
		'
		oBeforeWin = oCtrl.getIsWindowSplit()
		if oBeforeWin then
			oSplitCol = oCtrl.getSplitColumn()
			oSplitRow  = oCtrl.getSplitRow()
			'
			oDisp = "[ 分割位置 ]" & CHr$(10) & "( " & oSplitCol & " , " & oSplitRow & " )"
			msgbox(oDisp,0,"Split Window")
			'
			oDispatcher.executeDispatch(oFrame,  ".uno:SplitWindow", "", 0, oProp())
			oDisp = "分割を解除しました。"
		else
			oDisp = "Windowは分割されていません。"
		end if 
		'
		msgbox(oDisp,0,"Split Window")
End Sub

CSWn-)[Calc]Windowの分割位置取得(2)[ Pixel ]


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
	Dim oBeforeWin as Boolean
	Dim oSplitH as Long
	Dim oSplitV as Long
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		oCtrl.splitAtPosition(100, 150)
		'
		oBeforeWin = oCtrl.getIsWindowSplit()
		if oBeforeWin then
			oSplitH = oCtrl.getSplitHorizontal()
			oSplitV  = oCtrl.getSplitVertical()
			'
			oDisp = "[ 分割位置 ]" & CHr$(10) & "( " & oSplitH & " , " & oSplitV & " )"
			msgbox(oDisp,0,"Split Window")
			'
			oCtrl.splitAtPosition(0, 0)
			oDisp = "分割を解除しました。"
		else
			oDisp = "Windowは分割されていません。"
		end if 
		'
		msgbox(oDisp,0,"Split Window")
End Sub

CSWn-)[Calc]Windowの分割固定Check


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
	Dim oBeforeWin as Boolean
	Dim oCol as Long, oRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		'
		oBeforeWin = oCtrl.hasFrozenPanes()
		'
		if oBeforeWin = false then
			oCol = 3
			oRow = 7		' ( 3, 7 ) ← D8 Cell
			oCtrl.FreezeAtPosition(oCol , oRow)		' ( Column, Row )
			oDisp = "( Col, Row ) = ( " & oCol & " , " & oRow & "  )の位置で" & Chr$(10) & "固定区切を設定しました。"
			msgbox(oDisp,0,"Split Window")
			'
			Dim oFrame as Object
			Dim oDispatcher as Object
			Dim oProp(0) as new com.sun.star.beans.PropertyValue
				oFrame = ThisComponent.CurrentController.Frame
				oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
				oDispatcher.executeDispatch(oFrame, ".uno:FreezePanes", "", 0, oProp())
				'
				oDisp = "固定区切りを解除しました。"
		else
			oDisp = "既に分割固定されています"
		end if
		msgbox(oDisp,0,"Split Window")
End Sub

CSWn-)[Calc]表示Area取得(1)


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
	Dim oDispRange as Object
	Dim oDispSCol as Long, oDispECol as Long
	Dim oDispSRow as Long, oDispERow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		'
		oDispRange = oCtrl.getVisibleRange()
		'
		oDispSCol = oDispRange.StartColumn
		oDispECol = oDispRange.EndColumn
		oDispSRow = oDispRange.StartRow
		oDispERow = oDispRange.EndRow
		'
		oDisp = "[ 表示されているArea ]" & Chr$(10) & "( " & oDispSCol & ", " & oDispSRow & " ) ～ ( " & oDispECol & ", " & oDispERow & " )"
		msgbox(oDisp, 0,"Display")
End Sub
'
' [ Note ]
' Cellが少しでもはみ出ていると対象外

CSWn-)[Calc]表示Area取得(2)


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
	Dim oDispRange as Object
	Dim oDispSCol as Long, oDispECol as Long
	Dim oDispSRow as Long, oDispERow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		'
		oDispRange = oCtrl.getReferredCells()
		'
		oDispSCol = oDispRange.RangeAddress.StartColumn
		oDispECol = oDispRange.RangeAddress.EndColumn
		oDispSRow = oDispRange.RangeAddress.StartRow
		oDispERow = oDispRange.RangeAddress.EndRow
		'
		oDisp = "[ 表示されているArea ]" & Chr$(10) & "( " & oDispSCol & ", " & oDispSRow & " ) ～ ( " & oDispECol & ", " & oDispERow & " )"
		msgbox(oDisp, 0,"Display")
End Sub
'
' [ Note ]
' Cellが少しでもはみ出ていると対象外

CSWn-)[Calc]表示AreaのFirst CellのAddress取得


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
	Dim oDispSCol as Long, oDispSRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		'
		oDispSCol = oCtrl.getFirstVisibleColumn()
		oDispSRow = oCtrl.getFirstVisibleRow()
		'
		oDisp = "[ 表示されているArea ]" & Chr$(10) & "First Cell → ( " & oDispSCol & ", " & oDispSRow & " )"
		msgbox(oDisp, 0,"Display")
End Sub
'
' [ Note ]
' First Cellとは表示されている画面上の左上のCell

CSWn-)[Calc]表示AreaのFirst CellのAddress設定


Sub SheetWindow()
	Dim oDoc as Object, oCtrl as Object
	Dim oDispSCol as Long, oDispSRow as Long
	Dim oAftSCol as Long, oAftSRow as Long
		oDoc = ThisComponent
		oCtrl = oDoc.CurrentController
		'
		oDispSCol = oCtrl.getFirstVisibleColumn()
		oDispSRow = oCtrl.getFirstVisibleRow()
		'
		oCtrl.setFirstVisibleColumn(4)
		oCtrl.getFirstVisibleRow(3)
		'
		' Confirm
		oAftSCol = oCtrl.getFirstVisibleColumn()
		oAftSRow = oCtrl.getFirstVisibleRow()
		'
		oDisp = "[ 表示されているArea の First Cell ]" & Chr$(10) & "( " & oDispSCol & ", " & oDispSRow & " )" & "  から " & Chr$(10) & _
				"( " & oAftSCol & ", " & oAftSRow & " ) に変更されました。"
		msgbox(oDisp, 0,"Display")
End Sub

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

Calc No.3

###【 Previous Page ( Calc No.2 ) 】###

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

###【 Next Page ( Calc No.4 ) 】###

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

CS-)[Calc]Current Sheet名を取得

CS-)[Calc]Current CellのSheet名を取得

CS-2)[Calc]全てのSheet名を取得

CS-)[Calc]Sheet名があるかどうかを調べる。

CS-)[Calc]Sheetの新規挿入(1)

CS-)[Calc]Sheetの新規挿入(2)

CS-)[Calc]Sheetの新規挿入(3)

CS-)[Calc]Sheet内容の置換

CS-)[Calc]Sheetの保護/保護解除

CS-)[Calc]Sheetの保護Dialog表示

CS-)[Calc]SheetのCopy

CS-)[Calc]Sheetの移動

CS-)[Calc]Current SheetのCopy/移動

CS-)[Calc]Sheetの削除

CS-)[Calc]Current Sheetの削除

CS-)[Calc]Sheet名の変更(1)

CS-)[Calc]Sheet名の変更(2)[ Current Sheet ]

CS-)[Calc]Sheetの表示/非表示(1)

CS-)[Calc]Sheetの表示/非表示(2)

CS-)[Calc]Sheet Tab Colorの取得 / 設定

CS-)[Calc]Sheet背景色の設定

CS-)[Calc]Sheet Style取得

CS-)[Calc]Current Sheet Style取得

CS-)[Calc]Page Size取得

CS-)[Calc]上下左右余白取得

CS-)[Calc]余白設定

CS-)[Calc]Page StylのDialog表示

CS-)[Calc]行と列のFontName(英数字、日本語)設定。

CS-)[Calc]行と列のFontStyle設定。

CS-)[Calc]ActiveSheetを変更1

CS-)[Calc]ActiveSheetを変更2

CS-)[Calc]ActiveSheetを変更3

CS-)[Calc]ActiveSheetを変更4a[ Next Sheet ]

CS-)[Calc]ActiveSheetを変更4b[ Previosu Sheet ]

CS-)[Calc]ActiveSheetを追加選択[ Previosu Sheet ]( Ctrl + PageUp )

CS-)[Calc]ActiveSheetを追加選択[ Previosu Sheet ]( Ctrl + PageUp )

CS-)[Calc]複数のSheetを選択

CS-)[Calc]全Sheetを選択

CS-)[Calc]別のドキュメントから持ってきたsheetを挿入する。

CS-)[Calc]Sheet枚数取得

CS-)[Calc]Document内にSheetがあるか

CS-)[Calc]Document内にSheet名一覧

CS-)[Calc]Page Style Dialogの表示

CS-)[Calc]Sheet Themaの選択Dialog表示

CS-)[Calc]

CS-18)[Calc]SheetのLink1

CSL-)[Calc]SheetのLink2

CSL-)[Calc]別fileのCellとLink

CSC-)[Calc]Active Cellの移動(1)

CSC-)[Calc]Active Cellの移動(2)

CSC-)[Calc]Active Cellの移動(3)

CSC-)[Calc]Selected Cellを識別( One Cell or One Area or Multi Area )

CS-)[Calc]空白で無い次のData Cell( or Area Dataの端Cell )へ移動( Ctrl + ↑ / Ctrl + ↓ / Ctrl + → / Ctrl + ← )

CSC-)[Calc]Ctrl + End / 入力されているDataの最終Colmn, Rowへ移動・選択

CSC-)[Calc]Ctrl + Home / A1 Cellへ移動･選択

CSC-)[Calc]相対AddressでCurosor Cell/Range指定

CSC-)[Calc]Cursor範囲の拡大

CSC-)[Calc]Cursor範囲の拡大( Array Formula )

CSC-)[Calc]Cursor範囲の拡大( Merge Area )

CSC-)[Calc]Cursor範囲の拡大( Max row of same column )

CSC-)[Calc]Cursor範囲の拡大( Max column of same row )

CSC-)[Calc]Curosr範囲の拡大( 任意の位置( same with upper-left ) )

CSC-)[Calc]任意の範囲内のCuosor移動

CSC-)[Calc]Cellの編集Mode中のCursor位置変更

CSC-)[Calc]Page Down / Page Up / Page Left / Page Right

CSC-)[Calc]

CSWn-)[Calc]Windowの分割[上下] / 解除(1)

CSWn-)[Calc]Windowの分割[4分割] / 解除(2)

CSWn-)[Calc]Windowの分割[4分割] / 解除(3)

CSWn-)[Calc]Windowの分割固定 / 分割解除

CSWn-)[Calc]Windowの分割固定

CSWn-)[Calc]Windowの分割有無及び分割位置取得(1)[ Address ]

CSWn-)[Calc]Windowの分割位置取得(2)[ Pixel ]

CSWn-)[Calc]Windowの分割固定Check

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

【 Index 】

【 Macro Code 】