REM  *****  BASIC  *****
'このファイルはクリエイティブ・コモンズ・ライセンス「表示 - 非営利 2.1 日本 (CC BY-NC 2.1)」の下でライセンスされています。
'シート名指定版はCalcシートをシート名で把握して実行するマクロです（シート名を参照しますのでシートの並び順に影響を受けません）

'***************** メインルーチン登録エリア ********************
Option Explicit      'この命令を有効にすると、このモジュールで使用する変数は宣言しなければ使用できなくなります
'***************


'***************** サブルーチン　標準モジュール登録 ********************
'****************** 共通Public変数宣言 **************
Public End_Row As Long                 'データ最終行を格納する共通変数　行数を求める戻り値などに利用しています
'****************************************************
'****************************************************

Sub Data_Clear(SheetMei as string,Start_retsu as string,Start_gyou as long,End_retsu as string,End_gyou as long)
'*****************************************************************************
'*
'* 機能      : データ範囲をパラメータ指定してクリアします
'* 備考      : 開始行や終了行をパラメータで渡すことで指定範囲でデータ消去可能です
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.02.28	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名・開始列・開始行・終了列・終了行
'* 呼び出し例: Call Data_Clear("シート名","A",14,"AR",40)    'シート名のA14〜AR40をクリア
'*****************************************************************************

	Dim  sClear_Range as string

	sClear_Range = Start_retsu & Start_gyou  & ":" & End_retsu & End_gyou    'クリア範囲を指定

  	Rangeselect_clear(SheetMei,sClear_Range)         'シートを選択し、指定範囲をクリア
    
End Sub


Sub Range_Print(SheetMei as string,P_Area as string,Houkou as integer,Psize as integer)
'*****************************************************************************
'*
'* 機能      : 範囲指定して印刷(セル番地で範囲指定）
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.01.11	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名, 印刷範囲,  用紙方向（1：縦 2：横）,用紙サイズ（A4=1,A3=2）
'* 呼び出し例:Call Range_Print("シート名","A1:B20",1,2)     
'*****************************************************************************

    Dim oDoc as Object
    Dim oSheet as Object
    Dim oPrint_Range as Object
    Dim aPrint_Area(0) as Object
    Dim aArg(0) as new com.sun.star.beans.PropertyValue
    Dim aPrinter(1) as new com.sun.star.beans.PropertyValue

	If ThisComponent.getSheets.hasByName(SheetMei) = False then
 		Msgbox "印刷指定したシートが見つかりません",0,"処理を中止します"
 		Exit Sub
	End if    

	Call ActiveSheetMei(SheetMei)          '印刷する前に印刷対象となるシートをアクティブにします


    oDoc = ThisComponent
'    oSheet = oDoc.currentSelection.getSpreadsheet()
    oSheet = oDoc.Sheets.getByName(SheetMei)     'シート名を指定    
    oPrint_Range = oSheet.getCellRangeByName(P_Area).rangeAddress
    
    aPrint_Area(0) = oPrint_Range
    oSheet.setPrintAreas(aPrint_Area())
    aPrinter(0).name="PaperOrientation"

	If Houkou = 1 then
 		 aPrinter(0).Value = com.sun.star.view.PaperOrientation.PORTRAIT
	Else
 		 aPrinter(0).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
	End if

    aPrinter(1).name="PaperFormat"

	If Psize = 1 then
   		 aPrinter(1).value=com.sun.star.view.PaperFormat.A4
	Else
 		 aPrinter(1).value=com.sun.star.view.PaperFormat.A3
	End if

    aArg(0).name="Wait"
    aArg(0).value=True
    oDoc.Printer = aPrinter()
    ThisComponent.print(aArg())     'この行をコメントにすると印刷がキャンセルされます（プレビューはOK）テスト等に！

End Sub


Sub Print_out(SheetMei as string,s_retu as integer,s_gyou as long,e_retu as integer,e_gyou as long,houkou as integer,Psize as integer)
'*****************************************************************************
'*
'* 機能      : データ欄を範囲指定して印刷します（数値座標で範囲指定します）
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.02.28	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名・ 開始列・開始行 終了列・終了行   用紙方向（1：縦 2：横）,用紙サイズ（A4=1,A3=2）
'* 呼び出し例:Call  Print_out("Sheetいち",0,0,3,12,2,1)
'*****************************************************************************

	If ThisComponent.getSheets.hasByName(SheetMei) = False then
		Msgbox "印刷指定したシートが見つかりません",0,"処理を中止します"
		Exit Sub
	End if    


	Call ActiveSheetMei(SheetMei)         'シートをアクティブにします

	Dim oDoc As Object
	Dim oSheet As Object
	Dim oRange As Object
         oRange = New com.sun.star.table.CellRangeAddress 
 	 oDoc = ThisComponent
 	 oSheet = oDoc.Sheets.getByName(SheetMei)     'シート名を指定
 	 With oRange
   		 .Sheet = SheetMei             'シート名を指定
  		 .StartColumn = s_retu        '開始列 A=0
   		 .StartRow = s_gyou           '開始行が1行目の時=0
   		 .EndColumn = e_retu          '終了列は L=11
   		 .EndRow = e_gyou             '終了行が11行目の時=10
  	 End With
  
  oSheet.setPrintAreas(Array(oRange))

  Dim aPrintOption(0) As New com.sun.star.beans.PropertyValue
  Dim aPrinter(1) As New com.sun.star.beans.PropertyValue

  aPrinter(0).Name = "PaperOrientation"

	If houkou = 1 then
 		 aPrinter(0).Value = com.sun.star.view.PaperOrientation.PORTRAIT
	Else
 		 aPrinter(0).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
	End if

  aPrinter(1).Name = "PaperFormat"

	If Psize = 1 then
   		 aPrinter(1).value=com.sun.star.view.PaperFormat.A4
	Else
 		 aPrinter(1).value=com.sun.star.view.PaperFormat.A3
	End if
  
  oDoc.setPrinter(aPrinter())
  oDoc.print(aPrintOption())

End sub


Sub Rangeselect(SheetMei as string,DataArea as string)
'*****************************************************************************
'*
'* 機能      : セルを選択します
'* 備考      : 
'*****************************************************************************
'* 作成      ： JAFukuoka) W  " 2012.01.11	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名 ,選択範囲
'* 呼び出し例：	Call  Rangeselect("シート0","A1")    　'シート0　の　A1を選択
'* 備考：指定したシートが非表示の場合、隣のシートが選択されますので注意！
'*****************************************************************************
	Dim oController As Object
	Dim oSheet As Object

	oController = ThisComponent.getCurrentController()
	oSheet = ThisComponent.Sheets.getByName(SheetMei)

	oController.select (oSheet.getCellRangeByName(DataArea))      'アクティブなセルを指定選択

End Sub


Sub Rangeselect_clear(SheetMei as string,DataArea as string)
'*****************************************************************************
'*
'* 機能      : 範囲を選択し消去します
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.01.17	変更: 2015/08/09
'* 処理ファイル名
'* 引数内容 ：シート名,選択範囲
'* 呼び出し例:Call  Rangeselect_clear("シート0","A1:B5")
'*****************************************************************************
	Dim oSheet As Object

	oSheet = ThisComponent.Sheets.getByName(SheetMei)
	oSheet.getCellRangeByName(DataArea).clearContents(1+2+4+16)   '内容消去

End Sub

Sub Search_AEnd(SheetMei as string,RetsuCell as string,bangoukbn as integer)
'*****************************************************************************
'*
'* 機能      : アクティブ範囲の最終行を返す（表組の最終行など）
'* 備考      : シート番号,列座標『（例)A1』,戻り値番号区分（行番号:1  セル位置:2）
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.02.28	変更: 2015/08/09
'* 処理ファイル名：
'* 呼び出し例: Call Search_AEnd("シート名","A1",1)      'シート0のA列を基準にアクティブ範囲の最終行を返す 
'*****************************************************************************

       Dim oSheet As Object
       Dim oRange As Object
       Dim oAarea As Object

'       oSheet = ThisComponent.CurrentController.Activesheet
		oSheet = ThisComponent.Sheets.getByName(SheetMei)
       	oRange = oSheet.getCellRangeByName(RetsuCell)   
       	oAarea = oSheet.createCursorByRange(oRange)
       	oAarea.gotoEndOfUsedArea(True)
   
	End_Row = oAarea.Rows.Count

	If bangoukbn = 1 then
		 End_Row = End_Row	   	'戻り値：行番号を返します。（A3にデータがあった場合、3を返します）
	Else
		 End_Row = End_Row - 1 		'戻り値：セル指定用行番号。（A3にデータがあった場合、2を返します）
	End if

End Sub


Sub Search_DEnd(SheetMei as string,Col as integer,Bangoukbn as integer) 
'*****************************************************************************
'*
'* 機能      : 指定列データの最終行番号を取得(出力する行番号はセルの行番号とセル位置を選択可)
'* 引数      : シート番号・列番号『（例)A=0』・戻り値番号区分（行番号:1  セル位置:2）
'*****************************************************************************
'* 作成      : JAFukuoka) M  " 2012.03.09	変更: 2015/08/09
'* ・queryContentCellsメソッドの引数
'*  1：数値  2：日付と時刻   4：文字列  8：コメント  16：数式    32：セルに直接設定された書式
'* 64：スタイルによる書式（間接書式） 128：図形描画オブジェクト 256：セル内の一部の文字列に設定された書式
'* 呼び出し例: Call Search_DEnd("シート名",0,1)   'シート0のA列にあるデータの最終行を行番号で返す
'*****************************************************************************

	Dim oSheet as Object
	Dim oColumn as Object
	Dim oRanges as Object
	Dim iCountRange as long
	Dim iRowBottom as long
	Dim oRange as Object
    
		
	oSheet = ThisComponent.Sheets.getByName(SheetMei)
	
	oColumn = oSheet.getColumns().getByIndex(Col)

	oRanges = oColumn.queryContentCells(1+2+4+8+16)  '(引数：1と2と4と8と16に該当する値が入ったセルを指定している)
'	oRanges = oColumn.queryContentCells(31)  	 '(上記引数を合計した値31だけでも同じ動作が可能です)

	iCountRange = oRanges.getCount()
	
	If iCountRange = 0 Then                          'データがない時は0を返します。
		iRowBottom = -1
	Else
		oRange = oRanges.getByIndex(iCountRange-1 )
		iRowBottom = oRange.getRangeAddress().EndRow

	End If

	If Bangoukbn = 1 then
		 End_Row = iRowBottom+1   '戻り値：行番号。（A3にデータがあった場合、3を返します）
	Else
		 End_Row = iRowBottom     '戻り値：セル指定用行番号。（A3にデータがあった場合、2を返します）
	End if
	
End Sub


Sub Rangecopy_paste(CSheetMei as string,PSheetMei as string,CopyArea as string,Pastecell as string)
'*****************************************************************************
'*
'* 機能      : 指定範囲をコピー貼り付けします
'* 引数      : コピー元シート番号,貼り付け先シート番号,コピー範囲,貼り付けセル
'*****************************************************************************
'* 作成    : JAFukuoka) W " 2012.02.29	変更: 2015/08/09
'* 処理ファイル名：
'* 呼び出し例:Call Rangecopy_paste("Sheetいち","Sheetそのに","A1:B9","A20")
'*****************************************************************************

	Dim oSheetC As Object
	Dim oSheetP As Object
	Dim oRangeAddress As Object
	Dim oCellAddress As Object
	
	oSheetC = ThisComponent.Sheets.getByName(CSheetMei)           'コピー元シートを特定しています
	oSheetP = ThisComponent.Sheets.getByName(PSheetMei)           '貼り付け先シートを特定しています		
	oRangeAddress = oSheetC.getCellRangeByName(CopyArea).getRangeAddress()     'コピーする範囲を取得しています
	oCellAddress = oSheetP.getCellRangeByName(Pastecell).getCellAddress()           '貼り付け位置を特定しています
	oSheetP.copyRange(oCellAddress, oRangeAddress)     '貼り付けしています

End SUb


Sub Rangecopy_datapaste(CSheetMei as string,PSheetMei as string,CopyArea as string,PasteArea as string)
'*****************************************************************************
'*
'* 機能      : 指定範囲をコピー貼り付けします(値貼り付け)
'* 引数      : コピー元シート番号,貼り付け先シート番号,コピー範囲,貼り付けセル
'*****************************************************************************
'* 作成    : JAFukuoka) M " 2012.03.09	変更: 2015/08/09
'* 処理ファイル名：
'* 呼び出し例: Call Rangecopy_datapaste("Sheetいち","Sheetそのに","A1:B5","A1:B5")
'*****************************************************************************
	Dim oDoc as Object
	Dim oSheet1 as Object
    Dim oSheet2 as Object
	Dim oCopyData as Object
	Dim oCopyRange as Object
	Dim oPasteRange as Object

	oDoc = ThisComponent
	oSheet1 = oDoc.getSheets().getByName(CSheetMei)           'コピー元シートを特定しています
	oSheet2 = oDoc.getSheets().getByName(PSheetMei)           '貼り付け先シートを特定しています		
   	oCopyRange = oSheet1.getCellRangeByName(CopyArea)    'コピーする範囲を取得しています
	oPasteRange = oSheet2.getCellRangeByName(PasteArea)  '貼り付け位置を特定しています
	oCopyData = oCopyRange.getDataArray()
	oPasteRange.setDataArray(oCopyData)                         '値の貼り付け

End Sub


Sub SheetShow(sSheet as String)
'*****************************************************************************
'*
'* 機能      : シートの表示
'* 引数      : シート名
'*****************************************************************************
'* 作成    : JAFukuoka) Wat " 2015.08.15	変更: 2015/08/09
'* 処理ファイル名：
'* 呼び出し例:Call SheetShow("シート名") 
'*****************************************************************************

	Dim Sheet as Object
	Sheet = ThisComponent.Sheets.getByName(sSheet)
	Sheet.IsVisible = True ' 表示

End Sub


Sub SheetHide(sSheet as String)
'*****************************************************************************
'*
'* 機能      : シートの非表示
'* 引数      : シート名
'*****************************************************************************
'* 作成    : JAFukuoka) Wat " 2015.08.15	変更: 2015/08/09
'* 処理ファイル名：
'* 呼び出し例:Call SheetHide("シート名") 
'*****************************************************************************

	Dim Sheet as Object
	Sheet = ThisComponent.Sheets.getByName(sSheet)
	Sheet.IsVisible = False ' 非表示

End Sub


Sub Sort_pro(SheetMei as string,Sort_col as integer,Sort_area as string,Narabijun as string,Midashi as integer)
'*****************************************************************************
'*
'* 機能  　: 指定された項目で並び替えします
'* 引数  　: シート名・並び替え列（0〜・ソート範囲（A1:B3形式）・並び順（昇順=True 降順=False)・見出し行有無(有り：1　無し：2）
'* 列番号    :ソート範囲中の並び替え列を左から順に列番号（0〜）で設定します。
'             例）ソート範囲（B3:E20）の場合、並び替え列 B=0,C=1,D=2,E=3
'*****************************************************************************
'* 作成  　: JAFukuoka) W  " 2012.03.12	変更: 2015/08/09
'* 呼び出し例:Call Sort_pro("シート名",0,"B1:C35",true,1)　'シート名シート,B列,B1:C35の範囲,昇順,見出し有り　
'*****************************************************************************


       Dim oObjSheet As Object
       Dim oObjRange As Object
       Dim aObjSortDesc(1) As New com.sun.star.beans.PropertyValue
       Dim aObjSortKeys(0) As New com.sun.star.util.SortField

	'ソートする範囲を指定しています
	oObjRange =ThisComponent.Sheets.getByName(SheetMei).getCellRangeByName(Sort_area)
       
	'指定列をキーに昇順で並べ替え
       aObjSortKeys(0).Field  = Sort_col
       aObjSortKeys(0).SortAscending  = Narabijun
       
	'並べ替えキー設定
       aObjSortDesc(0).Name = "SortFields"
       aObjSortDesc(0).Value = aObjSortKeys()
       
	If Midashi = 1 then           '見出しが有る場合と無い場合
		aObjSortDesc(1).Name = "ContainsHeader"
		aObjSortDesc(1).Value = True    
	Else
		aObjSortDesc(1).Name = "ContainsHeader"
		aObjSortDesc(1).Value = False    
	End if

       '並べ替え実行
       oObjRange.sort(aObjSortDesc()) 

End Sub

Sub Sample_Sort(SheetMei as String,SortArea as String,f_key as integer,snd_key as integer,trd_key as integer)
'*****************************************************************************
'*
'* 機能  　: 指定された複数の項目（３項目）で並び替えします
'* サンプル例: アクティブシート・ソート範囲:（A1:C14)・並び替え列：（A列・B列・C列）
'*呼び出し例：Call Sample_Sort("Sheetいち","A1:G21",0,1,2)
'*****************************************************************************
'* 作成  　: JAFukuoka) M   2012.03.27 	変更: 2015/08/09
'* 
'*****************************************************************************
       Dim oObjSheet As Object
       Dim oObjRange As Object
       Dim aObjSortDesc(1) As New com.sun.star.beans.PropertyValue
       Dim aObjSortKeys(2) As New com.sun.star.util.SortField     'ソートフィールド用配列を３つ用意しています
      ' oObjSheet = ThisComponent.CurrentController.ActiveSheet
       oObjSheet = ThisComponent.Sheets.getByName(SheetMei)
       oObjRange = oObjSheet.getCellRangeByName(SortArea)
       
       '並べ替え時の第1優先キーはA列。並び順は昇順
       aObjSortKeys(0).Field  = f_key   '0=A列
       aObjSortKeys(0).SortAscending  = True  '昇順     False 降順　
       
       '並べ替え時の第2優先キーはB列。並び順は昇順
       aObjSortKeys(1).Field  = snd_key   '1=B列
       aObjSortKeys(1).SortAscending  = True   '昇順
       
       '並べ替え時の第3優先キーはC列。並び順は昇順
       aObjSortKeys(2).Field  = trd_key   '2=C列
       aObjSortKeys(2).SortAscending  = True   '昇順
       
       '並べ替えキー設定
       aObjSortDesc(0).Name = "SortFields"
       aObjSortDesc(0).Value = aObjSortKeys()
       
       'データに「行見出し」がない場合は  aObjSortDesc(1).Value = False
       aObjSortDesc(1).Name = "ContainsHeader"
       aObjSortDesc(1).Value = True         '行見出しがある場合はTure
       
       '並べ替えの実行
       ThisComponent.getCurrentController().select( oObjRange )
       oObjRange.sort(aObjSortDesc()) 
End Sub


Sub SheetProtect(SheetMei as string,PassWord as String,Kaijyokbn as integer)
'*****************************************************************************
'* システム名  :
'* 機能      : シートの保護・解除
'* 備考      : 
'*****************************************************************************
'* 作成  　JAFukuoka) M  " 2012.03.09	変更: 2015/08/09
'* 引数内容 ：シート名,パスワード（設定しない場合は""）,解除区分（設定：1、解除：2）
'* 呼び出し例:Call SheetProtect("シート名","",1)
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object

oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName(SheetMei)

	If Kaijyokbn = 1 then
		oSheet.Protect(PassWord) 'シートの保護
	Else
		oSheet.UnProtect(PassWord) 'シートの保護解除
	End If
End Sub

Sub RC_sounyu(SheetMei as string,RCNo as integer,Sounyusu as long,Gyouretukbn as integer)
'*****************************************************************************
'* システム名  :
'* 機能      : 行・列の挿入
'* 備考      : 
'*****************************************************************************
'* 作成  　JAFukuoka) M  " 2012.03.09	変更: 2015/08/09
'* 引数内容 ：シート名,挿入開始行・列No（1行目＝0、A列＝0）,挿入する行数・列数,挿入する行列の区分(行＝1・列＝2)
'*呼び出し例:Call RC_sounyu("シート名",0,5,2)     'シート名シートのA列から5列挿入します
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object
Dim oRows as Object
Dim oColumns as Object		

    If Gyouretukbn = 1 then
        oDoc=ThisComponent
        oSheet=oDoc.Sheets.getByName(SheetMei)
        oRows = oSheet.getRows()
        oRows.insertByIndex(RCNo,Sounyusu) 
    Else
        oDoc=ThisComponent
        oSheet=oDoc.Sheets.getByName(SheetMei)
        oColumns = oSheet.getColumns()
        oColumns.insertByIndex(RCNo,Sounyusu) 
    End if

End Sub

Sub RC_sakujyo(SheetMei as string,RCNo as integer,Sakujyosu as long,Gyouretukbn as integer)
'*****************************************************************************
'* システム名  :
'* 機能      : 行・列の削除
'* 備考      : 
'*****************************************************************************
'* 作成  　JAFukuoka) M  " 2012.03.09	変更: 2015/08/09
'* 引数内容 ：シート名,削除開始行.列No（1行目＝0、A列＝0）, 削除する行数・列数, 削除する行・列の区分(行＝1・列＝2)
'*呼び出し例:Call RC_sakujyo("シート名",0,5,2)     'シート名シートのA列から5列削除します
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object
Dim oRows as Object
Dim oColumns as Object
		
    If Gyouretukbn = 1 then
        oDoc=ThisComponent
        oSheet=oDoc.Sheets.getByName(SheetMei)
        oRows = oSheet.getRows()
        oRows.removeByIndex(RCNo,Sakujyosu) 
    Else
        oDoc=ThisComponent
        oSheet=oDoc.Sheets.getByName(SheetMei)
        oColumns = oSheet.getColumns()
        oColumns.removeByIndex(RCNo,Sakujyosu) 
    End if


End Sub

Sub RC_Visible(SheetMei as string,RCNo as integer,Gyouretukbn as integer)
'*****************************************************************************
'* システム名  :
'* 機能      : 行・列の表示
'* 備考      : 
'*****************************************************************************
'* 作成  　JAFukuoka) M  " 2012.03.09	変更: 2015/08/09
'* 引数内容 ：シート名,表示する行・列No(1行目＝0、A列＝0）, 表示する行列の区分(行＝1・列＝2)
'*呼び出し例:
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object
		
    If Gyouretukbn = 1 then
           oDoc = ThisComponent
           oSheet = oDoc.getSheets().getByName(SheetMei)
           oSheet.Rows(RCNo).isVisible=true

    Else
           oDoc = ThisComponent
           oSheet = oDoc.getSheets().getByName(SheetMei)
           oSheet.Columns(RCNo).isVisible=true
	
    End if

End Sub

Sub RC_Hide(SheetMei as string,RCNo as integer,Gyouretukbn as integer)
'*****************************************************************************
'* システム名  :
'* 機能      : 行・列の非表示
'* 備考      : 
'*****************************************************************************
'* 作成  　JAFukuoka) M  " 2012.03.09	変更: 2015/08/09
'* 引数内容 ：シート名,非表示にする行.列No（1行目＝0、A列＝0）,非表示する行・列の区分（行＝1・列＝2）
'*呼び出し例:
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object
		
  	If Gyouretukbn = 1 then
           oDoc = ThisComponent
           oSheet = oDoc.getSheets().getByName(SheetMei)
           oSheet.Rows(RCNo).isVisible=false

     Else
           oDoc = ThisComponent
           oSheet = oDoc.getSheets().getByName(SheetMei)
           oSheet.Columns(RCNo).isVisible=false

     End if

End Sub

Sub Auto_Filter() 
'*****************************************************************************
'*
'* 機能      : アクティブ範囲にオートフィルタの設定を行います。
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.03.28	変更: 2015/08/09
'* 処理ファイル名：
'*呼び出し例: Call Auto_filter   
'*****************************************************************************
Dim oDocument as Object 
Dim oDispatcher as Object 

oDocument   = ThisComponent.CurrentController.Frame 
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") 

'オートフィルタ実行 
oDispatcher.executeDispatch(oDocument, ".uno:DataFilterAutoFilter", "", 0, Array()) 

End Sub 

 
Sub Auto_Filter_check() 
'*****************************************************************************
'*
'* 機能 : 『データベース範囲の指定』で設定した範囲にオートフィルタが設定されているか？を判定
'* 備考 : 「データ」→「範囲の指定」→「データベース範囲の指定」で範囲名を設定可能。（例ではRange1）
'  上記設定で、名前を付けたデータベース範囲でオートフィルタをされているかどうか判定。
'*****************************************************************************
'* 作成      : JAFukuoka) M  " 2012.03.29 	変更: 2015/08/09
'***************************************************************************** 
Dim oDBArea as Object
  
oDBArea = ThisComponent.DatabaseRanges.getByName("Range1")
 
  If oDBArea.AutoFilter Then
     MsgBox "オートフィルタ有効"
  Else
     MsgBox "オートフィルタ無効"
  End If
 
End Sub

Sub ActiveSheetMei(SheetMei) 
'*****************************************************************************
'*
'* 機能 : 指定されたシートをアクティブにします
'* 備考 : 
'  
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2012.04.19 	変更: 2015/08/09
'***************************************************************************** 
	Dim oDoc as Object
	Dim oSheets as Object
	Dim oController as Object

    oDoc = ThisComponent 
    oController = oDoc.getCurrentController() 
    oSheets = oDoc.getSheets() 
    oController.setActiveSheet(oSheets.getByName(SheetMei)) 
End sub 

Sub ActiveSheet_Print(busuu as integer)
'*****************************************************************************
'*
'* 機能      : アクティブシートを印刷します。
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) M " 2012.04.15	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：部数
'* 呼び出し例:Call ActiveSheet_Print(2)  'アクティブシートを2部印刷します。  
'*****************************************************************************
	Dim oProps(0) as object
	oProps(0) = new com.sun.star.beans.PropertyValue
		
	oProps(0).Name = "CopyCount"
	oProps(0).Value = busuu
	ThisComponent.print(oProps())

End Sub

Sub End_gyou_UP (SheetMei as string,Start_gyou as long,Loop_End as long,Chk_col as integer)
'*****************************************************************************
'*
'* 機能      : 設定セルから上に移動して値が入力されているセル位置を返します（戻り値は変数：End_Rowに入ります）
'* 備考      : シートを名前で指定
'*****************************************************************************
'* 作成      : JAFukuoka) W " 2013.02.14	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名,開始行,ループ終わり数,データを探す列
'* 呼び出し例:Call End_gyou_UP("シート名",500,500,1)    '1シートのB列を500行位置からスタートして入力セルを調べます。  
'*****************************************************************************


Dim Chk_start_gyou as Long
Dim Loop_start_gyou as Long
Dim Chk_Loop_end as Long


Dim i as Long
Dim ii as Long

'パラメータで指定された行までカーソルを移動させ、そこから上がってきて値が入っている最初のセルがある行を返す

Chk_start_gyou = Start_gyou               '最初にチェックを開始するセル位置（500行を設定）
Chk_Loop_end = Loop_End		               'カーソルをループさせる回数

    i = 1
    ii = Chk_start_gyou

For  i = i To Chk_Loop_end         '指定行からデータ終了行までデータ処理します

Dim chkmoji as string
chkmoji = ThisComponent.Sheets.getByName(SheetMei).getCellByPosition(Chk_col, ii).string
	
	If IsNull(chkmoji) Or chkmoji = "" Then

                	 ii = ii - 1           'カウンターに-1で次のレコードを指示します
	else

        End_Row = ThisComponent.Sheets.getByName(SheetMei).getCellByPosition(Chk_col, ii).CellAddress.Row
		Exit Sub
	End if

Next i

End Sub


Sub Range_Replace(SheetMei as string,Replace_area as string,Search_w as string,Replace_w as string)
'*****************************************************************************
'*
'* 機能  　: 指定された範囲を置換します。
'* 引数  　: シート名,置換範囲,検索文字,置き換え文字
'*****************************************************************************
'* 作成  　: JAFukuoka) M  " 2012.04.18	変更: 2015/08/09
'* 呼び出し例:Call Range_Replace("シート名","A1:C15","A","B")
'*****************************************************************************

	Dim oSheet as object
	Dim oRange as object
	Dim oSearch as object
'	Dim oDisp as object

		oSheet = ThisComponent.Sheets.getByName(SheetMei)
		oRange = oSheet.getCellRangeByName(Replace_area)

		oSearch = oSheet.createReplaceDescriptor()
		With oSearch
			.SearchString = Search_w	'<=検索文字
			.ReplaceString = Replace_w	'<=置換文字
			.SearchWords = False 		'<=検索文字が一部含まれる(False),絶対一致(True)
			.SearchCaseSensitive = False	'<=大文字小文字区別する場合True
		End With

    'oDisp = oRange.replaceAll(oSearch)
 	oRange.replaceAll(oSearch)
End Sub


Sub SubTotal(SheetMei as string,goukeigyou1 as integer,goukeigyou2 as integer,groupretu as integer)
'*****************************************************************************
'*
'* 機能      : 小計を実施します
'* 備考      : ２つの項目で合計を表示したい例です（件数計と金額計など）
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2013.01.31	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ： シート名　, 合計行１,　合計行２,　グループ化列
'* 呼び出し例:  Call SubTotal("シート名",7,9,4)
'*****************************************************************************

	Dim oSheet as object
	Dim oSubTotalCol1 as object
	Dim oSubTotalCol2 as object
	Dim oDesc as object

	oSheet = ThisComponent.getSheets().getByName(SheetMei)        'シート名を指定
  
  ' 列の条件設定
	oSubTotalCol1 = CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
  
  '合計計算する列を指定しています　3を指定するとD列指定となります
	  oSubTotalCol1.Column =goukeigyou1
	  oSubTotalCol1.Function = com.sun.star.sheet.GeneralFunction.SUM

  ' 列の条件設定
	  oSubTotalCol2 = CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
  
  '合計計算する列を指定しています　4を指定するとE列指定となります
  oSubTotalCol2.Column =goukeigyou2
  oSubTotalCol2.Function = com.sun.star.sheet.GeneralFunction.SUM


  oDesc = oSheet.createSubTotalDescriptor(True)
 
    'グループ化する列を指定しています　2=C列
  oDesc.addNew(Array(oSubTotalCol1,oSubTotalCol2), groupretu)
'  oDesc.addNew(Array(oSubTotalCol), 0)

  oDesc.BindFormatsToContent = True
  oDesc.EnableSort = False      'このモジュールでの並び替えをやらない
'  oDesc.SortAscending = True               '昇順を有効にする
  oSheet.applySubTotals(oDesc, True)

End Sub


Sub SubTotaldel(SheetMei as string)
'*****************************************************************************
'*
'* 機能      : データの小計を解除します
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2013.01.31	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名
'* 呼び出し例：　Call SubTotaldel("シート名")
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object

  oDoc = ThisComponent
  oSheet = oDoc.getSheets().getByName(SheetMei)
  oSheet.removeSubTotals()


End Sub


Sub SheetNumber(Sheetmei as string)as integer
'*****************************************************************************
'*
'* 機能      : シート名からシート番号を取り出す
'* 備考      : 
'*****************************************************************************
'* 作成      : JAFukuoka) W  " 2013.04.30	変更: 2015/08/09
'* 処理ファイル名：
'* 引数内容 ：シート名
'* 呼び出し例：　Call SheetNumber("明細表")
'*****************************************************************************
    Dim Sheets as object
    Dim Sheet as object
    Dim sNames as object
    Dim Sheetindex as integer 
    Dim i as long

    Sheetindex = 0
   Sheets = ThisComponent.getSheets()

   If (Sheets.hasByName(SheetMei)) Then
        
        sNames = sheets.getElementNames()
        Sheetindex = 0
        
        For i = 0 to sheets.getCount()-1
            If sNames(i) = SheetMei Then
                Sheetindex = i + 1
                Exit For
             End If
        Next i
        
    End If

If Sheetindex <= 0 then
	Msgbox "指定したシート名がありません",0,"処理を中止します"
	Exit Sub
End if

	Msgbox "シート番号は" & Sheetindex-1 & "です" ,0,"処理を終わります"
 
End Sub



Sub Sheet_chk(cSheetMei as String)
'*****************************************************************************
'*
'* 機能 : 指定されたシートの有無をチェック
'* 備考 : 
'*呼び出し例:Call Sheet_chk("シート名")
'*****************************************************************************
'* 作成      : 	JAFukuoka) W　2015/08/15
'***************************************************************************** 

If ThisComponent.getSheets.hasByName(cSheetMei) = False then
 Msgbox "指定したシートが見つかりません",0,"処理を中止します"
 Exit Sub
End if    

End Sub


Sub CellMergeONOFF(Sheetmei as string,ChkArea as string)
' *************************
rem セルを結合する true   解除：false
' セル結合　オン・オフ　
' *************************
'*****************************************************************************
'* 作成      : 	JAF　　　2021/04/15
'*****************************************************************************
    Dim oSheets As Object
    Dim oSheet  As Object
    Dim oRange  As Object

    oSheets = ThisComponent.Sheets
    oSheet = oSheets.getByName(Sheetmei)

    oRange = oSheet.getCellRangeByName(ChkArea)
 '   oRange.merge(True)
    oRange.merge(False)
    
End Sub