Sheet操作[ com.sun.star.sheet.Spreadsheets service ]
[ Link ]
[ Sheet Cursors ]( com.sun.star.sheet.SheetCellCursor → LibreOffice / Apache OpenOffice )
[ Window ]
View( com.sun.star.sheet.SpreadsheetViewSettings Service )
Data Pilot
GoalSeek[ com.sun.star.sheet.GoalResult ]
Scenario
Graph Chart作成
画像
印刷操作
[ Prinetr ]
file操作
CSV file操作
Web関係
その他
Sheet操作
Sub CalcSheet()
Dim oDoc as Object
Dim oCtrl as Object
Dim 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
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
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
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
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
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
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
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
Sub CalcSheet()
Dim oDoc as Object
Dim oSheet as Object
Dim oSpdSht as Object
Dim oShtName as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets()
oShtName = "Sheet1"
'
oSpdSht = oDoc.createInstance("com.sun.star.sheet.Spreadsheet")
'
oDisp = "Sheet名 : " & oShtName & Chr$(10)
if NOT oSheet.getByName(oShtName).IsProtected then
oSpdSht.protect( oShtName, "password")
oDisp = oDisp & "を 保護しました。"
else
oDisp = oDisp & "は既に保護されています。"
end if
msgbox(oDisp, 0, "Sheetの保護")
'
' Instance化は毎回必要
oSpdSht = oDoc.createInstance("com.sun.star.sheet.Spreadsheet")
oSpdSht.unprotect( oShtName, "password")
oDisp = "Sheet名 : " & oShtName & Chr$(10)
if NOT oSheet.getByName(oShtName).IsProtected then
oDisp = oDisp & "の 保護を解除しました。"
else
oDisp = oDisp & "の解除に失敗しました。"
end if
msgbox(oDisp, 0, "Sheetの保護解除")
End Sub
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"
End Sub
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
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
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
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
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
Sub oChangeSheetName
Dim oDoc As Object, oSheet1 as Object
oDoc = ThisComponent
oSheet1=oDoc.Sheets(0)
oSheet1.Name="Calc1"
End Sub
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
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
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
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
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
Sub oSheet
Dim oDoc
Dim oSheet
Dim oPageStyle
oDoc = ThisComponent
oSheet = oDoc.CurrentController.getActiveSheet()
oSheetStyle = oSheet.PageStyle
oDisp = oSheetStyle
msgbox(oDisp,0,"Sheet")
End Sub
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
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
Sub oSheet
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
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
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
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
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
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
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に戻る訳では無い
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には移らない。
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の選択は解除されない。
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の選択は解除されない。
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
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
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
Sub oSheetSpreadsheets
Dim oDoc
oDoc = ThisComponent
oSheets= oDoc.Sheets
oNum = oSheets.getCount()
oDisp = "Sheet枚数 => " & oNum
msgbox(oDisp,0,"Sheet枚数取得")
End Sub
Sub oSheetSpreadsheets
Dim oDoc
oDoc = ThisComponent
oSheets= oDoc.Sheets
oDisp=oSheets.hasElements()
msgbox(oDisp,0,"com.sun.star.sheet.Spreadsheets")
End Sub
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
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
[ Link ]
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
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
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 ]
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
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
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
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
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
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の末尾へ
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の先頭へ
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 の値は取得不可である。
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
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
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
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
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
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
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
[ 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 = "$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
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
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
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
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
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
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
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
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が少しでもはみ出ていると対象外
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が少しでもはみ出ていると対象外
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
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
View
Sub CalcView()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Page Preview Mode
oDispatcher.executeDispatch( oFrame, ".uno:PagebreakMode", "", 0, Array())
msgbox "Page Break Preview",0,"View"
' Normal Mode
oDispatcher.executeDispatch( oFrame, ".uno:NormalViewMode", "", 0, Array())
msgbox "Normal Mode",0,"View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oCtrl.ShowPageBreaks = true
msgbox "Page Break Line表示",0,"View"
' Normal Mode
oCtrl.ShowPageBreaks = false
msgbox "Page Break Line非表示",0,"View"
End Sub
Sub CalcUnoView()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "InputLineVisible"
oProp(0).Value = false
oDispatcher.executeDispatch( oFrame, ".uno:InputLineVisible", "", 0, oProp())
msgbox "式入力Box非表示",0,"View"
'
oProp(0).Name = "InputLineVisible"
oProp(0).Value = true
oDispatcher.executeDispatch( oFrame, ".uno:InputLineVisible", "", 0, oProp())
msgbox "式入力Box表示",0,"View"
End Sub
Sub CalcUnoView()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "FunctionBox"
oProp(0).Value = true
oDispatcher.executeDispatch( oFrame, ".uno:FunctionBox", "", 0, oProp())
msgbox "関数List表示",0,"View"
'
oProp(0).Name = "FunctionBox"
oProp(0).Value = false
oDispatcher.executeDispatch( oFrame, ".uno:FunctionBox", "", 0, oProp())
msgbox "関数List非表示",0,"View"
End Sub
Sub CalcUnoView()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch( oFrame, ".uno:ViewRowColumnHeaders", "", 0, oProp())
msgbox "行、列番号非表示",0,"View"
'
oDispatcher.executeDispatch( oFrame, ".uno:ViewRowColumnHeaders", "", 0, oProp())
msgbox "行、列番号非表示",0,"View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.ColumnRowHeaders = false
msgbox "行、列番号非表示",0,"CalcView"
'
oCtrl.ColumnRowHeaders = true
msgbox "行、列番号表示",0,"ClacView"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.HasColumnRowHeaders = false
msgbox "行、列番号非表示",0,"CalcView"
'
oCtrl.HasColumnRowHeaders = true
msgbox "行、列番号表示",0,"ClacView"
End Sub
Sub CalcUnoView()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch( oFrame, ".uno:ViewValueHighlighting", "", 0, oProp())
msgbox "値の強調表示ON" & Chr(10) & "Colorが付く",0,"View"
'
oDispatcher.executeDispatch( oFrame, ".uno:ViewValueHighlighting", "", 0, oProp())
msgbox "値の強調表示OFF" & Chr(10) & "Blackに戻る",0,"View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.ValueHighlighting = true
msgbox "値の強調表示ON" & Chr(10) & "Colorが付く",0,"CalcView"
'
oCtrl.ValueHighlighting = false
msgbox "値の強調表示OFF" & Chr(10) & "Blackに戻る",0,"ClacView"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.IsValueHighlightingEnabled = true
msgbox "値の強調表示ON" & Chr(10) & "Colorが付く",0,"CalcView"
'
oCtrl.IsValueHighlightingEnabled = false
msgbox "値の強調表示OFF" & Chr(10) & "Blackに戻る",0,"ClacView"
End Sub
Sub WindowZoom()
Dim oDoc as Object, oCtrl as Object
Dim oZoom1 as Long, oZoom2 as Long
Dim oDisp as String
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
' Current Zoom
oZoom1 = oCtrl.ZoomValue
'
oCtrl.ZoomValue = 125 ' 拡大率を指定するときのみ ZoomValue を使用
' ZoomType は ZoomValueの後にする事.
'oCtrl.ZoomType = 3 ' こちらでもOK
oCtrl.ZoomType = com.sun.star.view.DocumentZoomType.BY_VALUE
'
oZoom2 = oCtrl.ZoomValue
oDisp = "[ View → Zoom ]" & Chr$(10) & "Before = " & oZoom1 & Chr$(10) & "After = " & oZoom2
'
msgbox(oDisp,0,"画面Zoom")
End Sub
'
' [ Note ]
' 1) ZoomType の値が .uno:Zoom と異なる事に注意。
'
' OPTIMAL : 0 / 選択範囲に合わせる
' PAGE_WIDTH : 1 / ページ幅に合わせる
' ENTIRE_PAGE : 2 / 縦横ページ全体を表示
' BY_VALUE : 3 / 拡大率を指定してズーム
' PAGE_WIDTH_EXACT : 4 / 正確なページ幅
'
' 2) Calc以外は .uno:Zoom使用。Calcも .uno:Zoom で設定できる。
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.ShowGrid = false
msgbox "Grid線を非表示",0,"CalcView"
'
oCtrl.ShowGrid = true
msgbox "Grid線表示",0,"ClacView"
End Sub
'
' [ Note ]
' Calc Only / WriterではError
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.GridColor = &HFF0000 ' Red
msgbox "Success"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.HideSpellMarks = false
msgbox "Auto Spell Check / ON",0,"Spell Check"
'
oCtrl.HideSpellMarks = false
msgbox "Auto Spell Check / OFF",0,"Spell Check"
End Sub
'
' [ Note ]
' Errorは生じないが、Spell記号(赤字の下波線)のON/OFF反応無し。( LibreOffice4.0.1 , Apache OpenOffice3.4 )
' LO, AOO 共に com.sun.star.sheet.SpreadSheetViewSetting Serviceに記載有り。
' Auto Spell Check( Spell記号の表示/非表示 )ならばOK
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.HorizontalScrollBar = false
msgbox "水平Scroll Bar非表示",0,"Calc View"
'
oCtrl.HorizontalScrollBar = true
msgbox "水平Scroll Bar表示",0,"Calc View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.VerticalScrollBar = false
msgbox "垂直Scroll Bar非表示",0,"Calc View"
'
oCtrl.VerticalScrollBar = true
msgbox "垂直Scroll Bar表示",0,"Calc View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' 事前準備
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox "Goup化 OK",0,"Display"
'
oCtrl = oDoc.getCurrentController()
oCtrl.OutlineSymbols = false
msgbox "OutlineSymbol非表示",0,"Calc View"
'
oCtrl.OutlineSymbols = true
msgbox "OutlineSymbol表示",0,"Calc View"
'
oSheet.clearOutline()
msgbox "Success"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' 事前準備
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox "Goup化 OK",0,"Display"
'
oCtrl = oDoc.getCurrentController()
oCtrl.IsOutlineSymbolsSet = false
msgbox "OutlineSymbol非表示",0,"Calc View"
'
oCtrl.IsOutlineSymbolsSet = true
msgbox "OutlineSymbol表示",0,"Calc View"
'
oSheet.clearOutline()
msgbox "Success"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oCtrl.SheetTabs = false
msgbox "Sheet Tab非表示",0,"Calc View"
'
oCtrl.SheetTabs = true
msgbox "Sheet Tab表示",0,"Calc View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oCtrl.HasSheetTabs = false
msgbox "Sheet Tab表示 ? = " & oCtrl.HasSheetTabs ,0,"Calc View"
'
oCtrl.HasSheetTabs = true
msgbox "Sheet Tab表示 ? = " & oCtrl.HasSheetTabs,0,"Calc View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
Dim oSpdSht as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oCtrl.SheetTabs = false
'
oSpdSht = oDoc.createInstance("com.sun.star.sheet.DocumentSettings")
Rem oSpdSht = oDoc.createInstance("com.sun.star.comp.SpreadsheetSettings") ' ← こちらでもOK
msgbox "Sheet Tab表示 ? = " & oSpdSht.HasSheetTabs ,0,"Calc View"
'
oCtrl.SheetTabs = true
msgbox "Sheet Tab表示 ? = " & oSpdSht.HasSheetTabs,0,"Calc View"
End Sub
'
' [ Note ]
' com.sun.star.sheet.DocumentSettings / com.sun.star.comp.SpreadsheetSettings では設定不可
' 設定するには CurrentController() ( つまり com.sun.star.sheet.SpreadsheetViewSettings ) を使う
Sub CalcView()
Dim oDoc as Object, oCtrl as Object, oFrame
Dim oDrawP as Object
Dim oShape as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oDrawP = oDoc.getDrawPages().getByIndex(0)
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = 1000
oPoint.Y = 1000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 1200 ' unit : 1/100mm
oSize.Width = 1500 ' unit : 1/100mm
oShape.Size = oSize
oDrawP.add(oShape)
'
' 作成したShapeを選択状態にする
oCtrl = oDoc.CurrentController()
oCtrl.select(oShape)
'
' AnchorをCell に設定
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToCell", "", 0, Array())
'
' 一度、Objectの選択を解除 / Cell を選択
oProp(0).Name = "ToPoint"
oProp(0).Value = "A10"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
' Anchor 表示/非表示
oCtrl.ShowAnchor = false
oCtrl.select(oShape)
msgbox "ObjectのAnchor非表示",0,"Calc View"
'
oCtrl.ShowAnchor = true
oCtrl.select(oShape)
msgbox "ObjectのAnchor表示",0,"Calc View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
Dim oDrawP as Object
Dim oShape as Object
oDoc = ThisComponent
oDrawP = oDoc.getDrawPages().getByIndex(0)
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = 1000
oPoint.Y = 1000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 1200 ' unit : 1/100mm
oSize.Width = 1500 ' unit : 1/100mm
oShape.Size = oSize
oDrawP.add(oShape)
'
' 図形Object 表示/非表示
oCtrl = oDoc.getCurrentController()
oCtrl.ShowDrawing = true
msgbox "図形Objectの非表示" & Chr$(10) & "( ShowDrawing )",0,"Calc View"
'
oCtrl.ShowDrawing = false
msgbox "図形Objectの表示" & Chr$(10) & "( ShowDrawing )",0,"Calc View"
End Sub
'
' [ Note ]( LibreOffice4.0.1 )
' true : Not Display
' false : Display
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oCtrl.ShowHelpLines = false
msgbox "Show Help Line = " & oCtrl.ShowHelpLines ,0,"Calc View"
'
oCtrl.ShowHelpLines = true
msgbox "Show Help Line = " & oCtrl.ShowHelpLines,0,"Calc View"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
Dim oDrawP as Object
Dim oShape as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
' 事前に Embedded Objectを作成
oCtrl.ShowObjects = 1
msgbox "Embed Objectの非表示",0,"Calc View"
'
oCtrl.ShowObjects = 2
msgbox "Image 枠 表示",0,"Calc View"
'
oCtrl.ShowObjects = 0
msgbox "Embed Objectの表示",0,"Calc View"
End Sub
'
' [ Note ]
' oCtrl.ShowObjects = 2 では Image枠のみで無く、全体が表示されてしまう( LO4.0.1 )
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.ShowFormulas = true
msgbox "数式表示",0,"CalcView"
'
oCtrl.ShowFormulas = false
msgbox "値表示",0,"ClacView"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
oCtrl.ShowZeroValues = false
msgbox "Zero( = 0 ) 非表示",0,"CalcView"
'
oCtrl.ShowZeroValues = true
msgbox "Zero( = 0 ) 表示",0,"ClacView"
End Sub
Sub CalcView()
Dim oDoc as Object
Dim oSheet as Object, oCell as Object
Dim oCmt as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
' Annotation Object 作成
oCmt = oCell.getAnnotation()
' 新規Commentの挿入
oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの挿入")
'
' Commentの非表示
oCmt.setIsVisible( false )
msgbox "Comment非表示",0,"ClacView"
'
' Commentの表示
oCmt.setIsVisible( true )
msgbox "Comment表示",0,"ClacView"
End Sub
Sub DocUnoCalc()
Dim oDoc As Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A1 Cellへ
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Commnet常時表示
oProp(0).Name = "NoteVisible"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:NoteVisible", "", 0, oProp())
msgbox "Commnet常時表示",0,"Comment"
' Commnet通常表示
oProp(0).Name = "NoteVisible"
oProp(0).Value = ｆａｌｓｅ
oDispatcher.executeDispatch(oFrame, ".uno:NoteVisible", "", 0, oProp())
msgbox "Commnet通常表示",0,"Comment"
End Sub
Sub CalcView()
Dim oDoc as Object, oCtrl as Object
Dim oSheet as Object, oCell as Object
Dim oCmt as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
' Annotation Object 作成
oCmt = oCell.getAnnotation()
' 新規Commentの挿入
oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの表示")
'
' Comment Markの非表示
oCtrl = oDoc.getCurrentController()
oCtrl.ShowNotes = false
msgbox "Comment Mark非表示" & Chr$(10) & "(右上角の■ 無し",0,"ClacView"
'
' Commentの表示
oCtrl.ShowNotes = true
msgbox "Comment Mark非表示" & Chr$(10) & "右上角の■有り",0,"ClacView"
End Sub
Sub CalcView()
Dim oDoc as Object
Dim oSnapRst as Boolean
Dim oRstIsVisi as Boolean
Dim oRstX as Long, oRstY as Long
Dim oRstSubX as Long, oRstSubY as Long
Dim oSynRst as Boolean
oDoc = ThisComponent
'
oSpdSht = oDoc.createInstance("com.sun.star.sheet.DocumentSettings")
' こちらでも OK
Rem oSpdSht = oDoc.createInstance("com.sun.star.comp.SpreadsheetSettings")
'
' オプション → Calc → グリッド線 / Readonly
' 「 グリッド線で位置合わせ 」設定取得
oSnapRst = oSpdSht.IsSnapToRaster
' 「 グリッド線の表示 」設定取得
oRstIsVisi = oSpdSht.RasterIsVisible
' 「 解像度 」
oRstX = oSpdSht.RasterResolutionX
oRstY = oSpdSht.RasterResolutionY
' 「 サブ目盛 」
oRstSubX = oSpdSht.RasterSubdivisionX
oRstSubY = oSpdSht.RasterSubdivisionY
' 「 軸を同期させる 」
oSynRst = oSpdSht.IsRasterAxisSynchronized
'
oDisp = "[ Option : Grid設定取得 ]" & Chr$(10) & "「 グリッド線で位置合わせ 」 = " & oSnapRst & Chr$(10) & _
" 「 グリッド線の表示 」 = " & oRstIsVisi & Chr$(10) & _
"解像度 / 「横に」 = " & oRstX & Chr$(10) & "解像度 / 「縦に」 = " & oRstY & Chr$(10) & _
"サブ目盛 / 「横に」 = " & oRstSubX & Chr$(10) & "サブ目盛 / 「縦に」 = " & oRstSubY & Chr$(10) & _
"「 軸を同期させる 」 = " & oSynRst
'
msgbox oDisp, 0, "Option設定"
End Sub
'
' [ Note ]
' サブ目盛 の取得値は表示される値から -1
' 4 ならば 取得値は 3
Data Pilot
Sub oCreateDataPilotSource()
Dim oName
Dim oItem()
Dim oTeam()
Dim oCity()
Dim oInvCompany
Dim ovalSheets
Dim oSheet
Dim i as Integer
Dim nItem as Integer
Dim nCity as integer
Dim nTeam as Integer
Dim d2007 as Double
Dim d2008 as Double
Dim d2009 as Double
oName = "DataPilot"
ovalSheets = ThisComponent.Sheets
If NOT ovalSheets.hasByName(oName) then
ovalSheets.insertNewByName(oName, ovalSheets.getCount()) ' ← 最後尾にsheetを追加
End If
oSheet = ovalSheets.getByName(oName)
oItem = Array("Books","Candy","Pens")
oTeam = Array("Jean","Bob","Ilsub","Alan","Chelle","Andy")
oCity = Array("Michigan","Ohio","Kentucky")
oData = DimArray((UBound(oItem)+1) * (UBound(oTeam)+1))
oData(0) = Array("Item", "State", "Team", "2007", "2008", "2009")
Dim a()
a = oData(0,0)
oDisp = oDisp & a(0) & Chr$(9) & a(1) & Chr$(9) & a(2) & Chr$(9) & a(3) & Chr$(9) & a(4) & Chr$(9) & a(5)
oDisp= oDisp & Chr$(10)
i=0
for nTeam = 0 to UBound(oTeam)
for nItem = 0 to UBound(oItem)
'print UBound(oItem)
i=i+1
d2007 = 1000.0 + 2000.0* Rnd
d2008 = 1500.0 + 2000.0* Rnd
d2009 = 2000.0 + 2000.0* Rnd
oData(i) = Array(oItem(nItem), oCity(nIem), oTeam(nTeam), Int(d2007), Int(d2008), Int(d2009))
a = oData(i)
oDisp = oDisp & a(0) & Chr$(9) & a(1) & Chr$(9) & a(2) & Chr$(9) & a(3) & Chr$(9) & a(4) & Chr$(9) & a(5)
oDisp= oDisp & Chr$(10)
next nItem
next nTeam
msgbox(oDisp)
oRange = oSheet.getCellRangeByName("A1:F" & (UBound(oData)+1))
oRange.setDataArray(oData)
'
Dim oFormats
Dim oTempRange
oTempRange = oSheet.getCellRangeByName("D2:F" & (UBound(oData)+1))
oFormats = ThisComponent.NumberFormats
Dim oLocale as new com.sun.star.lang.Locale
oTempRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.CURRENCY, oLocale)
oTempRange = oSheet.getCellRangeByName("A1:F1")
oTempRange.CellBackColor = RGB(200,200,200)
oTempRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
End Sub
Sub oCreateDataPilotTable
Dim oSheet
Dim oRange
Dim oRangeAddress
Dim oTables
Dim oTDescriptor
Dim oAllFields
Dim oField
Dim oCellAddress as new com.sun.star.table.CellAddress
Randomize(37)
oRange = oDataPilotSource("Pilot")
'
oRangeAddress = oRange.getRangeAddress()
oCellAddress.Sheet = oRangeAddress.Sheet
oCellAddress.Column = oRangeAddress.StartColumn
oCellAddress.Row = oRangeAddress.EndRow + 2
oSheet = ThisComponent.Sheets.getByName("Pilot")
oTables = oSheet.getDataPilotTables()
' Step1 Create the descriptor
oTDescriptor = oTables.createDataPilotDescriptor()
' Sep2 Set the Source Range
oTdescriptor.setSourceRange(oRangeAddress)
' Step3 Set the fileds
oAllFields = oTDescriptor.getDataPilotFields()
'Define to be the Column0 as a row item
oField = oAllFields.getByIndex(0)
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
'Define to be the Column1 as a Column item
oField = oAllFields.getByIndex(1)
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN
'Define to be Created a sum in the data for the Column3
oField = oAllFields.getByIndex(3)
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
oField.Function = com.sun.star.sheet.GeneralFunction.SUM
'
oTables.insertNewByName("MyFirstDataPilot", oCellAddress, oTDescriptor)
End Sub
'
'[ Function1 ]
Function oDataPilotSource(oName) as Varient
Dim oItem()
Dim oTeam()
Dim oCity()
Dim oInvCompany
Dim ovalSheets
Dim oSheet
Dim i as Integer
Dim nItem as Integer
Dim nCity as integer
Dim nTeam as Integer
Dim d2007 as Double
Dim d2008 as Double
Dim d2009 as Double
ovalSheets = ThisComponent.Sheets
If NOT ovalSheets.hasByName(oName) then
ovalSheets.insertNewByName(oName, ovalSheets.getCount()) ' ← 最後尾にsheetを追加
End If
oSheet = ovalSheets.getByName(oName)
oItem = Array("Books","Candy","Pens")
oTeam = Array("Jean","Bob","Ilsub","Alan","Chelle","Andy")
oCity = Array("Michigan","Ohio","Kentucky")
oData = DimArray((UBound(oItem)+1) * (UBound(oTeam)+1))
oData(0) = Array("Item", "State", "Team", "2007", "2008", "2009")
dim a()
a = oData(0,0)
oDisp = oDisp & a(0) & Chr$(9) & a(1) & Chr$(9) & a(2) & Chr$(9) & a(3) & Chr$(9) & a(4) & Chr$(9) & a(5)
oDisp= oDisp & Chr$(10)
i=0
for nTeam = 0 to UBound(oTeam)
for nItem = 0 to UBound(oItem)
i=i+1
d2007 = 1000.0 + 2000.0* Rnd
d2008 = 1500.0 + 2000.0* Rnd
d2009 = 2000.0 + 2000.0* Rnd
oData(i) = Array(oItem(nItem), oCity(nIem), oTeam(nTeam), Int(d2007), Int(d2008), Int(d2009))
next nItem
next nTeam
oRange = oSheet.getCellRangeByName("A1:F" & (UBound(oData)+1))
oRange.setDataArray(oData)
'
Dim oFormats
Dim oTempRange
oTempRange = oSheet.getCellRangeByName("D2:F" & (UBound(oData)+1))
oFormats = ThisComponent.NumberFormats
Dim oLocale as new com.sun.star.lang.Locale
oTempRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.CURRENCY, oLocale)
oTempRange = oSheet.getCellRangeByName("A1:F1")
oTempRange.CellBackColor = RGB(200,200,200)
oTempRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
'Return
oDataPilotSource = oRange
End Function
Sub oRemoveDataPilot
Dim oSheet
oSheet = ThisComponent.Sheets.getByName("Pilot")
oTables = oSheet.getDataPilotTables()
oRDescriptor = oTables.removeByName("MyFirstDataPilot")
End Sub
Sub GeneralMenu()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch( oFrame, ".uno:DataDataPilotRun", "", 0, Array())
msgbox "Success"
End Sub
GoalSeek
Sub oGoakSeek
Dim oDoc as Object
Dim oSheet as Object
Dim oTCell as Object
Dim oRCell as Object
Dim oGoal as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oTCell = oSheet.getCellByPosition(1,0)
oTCell.Value = 1
'
oRCell = oSheet.getCellByPosition(0,0)
oRCell.Formula= "=10*B1"
'GoalSeek
oGoal = oDoc.seekGoal(oRCell.CellAddress, oTCell.CellAddress, "100")
'Display
msgbox("Result = " & oGoal.Result & Chr$(10) & _
"The result changed by " & oGoal.Divergence & " in the last iteration", 0, "Goal Seek")
End Sub
Sub UnoGoakSeek()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch(oFrame, ".uno:GoalSeekDialog", "", 0, Array())
End Sub
Scenario
Sub CalcScenario()
Dim oDoc As Object
Dim oSheet as Object
Dim oSnr as Object
Dim oCellRange as Object, oCellRangeAddr as Object
Dim oSnrName as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("Sheet1")
' 前準備
oSheet.getCellByPosition(0,0).String = "定価"
oSheet.getCellByPosition(0,1).String = "割引率"
oSheet.getCellByPosition(0,2).String = "税金"
oSheet.getCellByPosition(0,3).String = "送料"
oSheet.getCellByPosition(0,4).String = "購入価格"
'
oSheet.getCellByPosition(1,0).Value = 10000
oSheet.getCellByPosition(1,1).Value = 0.1
oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
oSheet.getCellByPosition(1,3).Value = 500
oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
'
' Scenario作成 ( シナリオ1 )
oSnrName = "Scenario_1"
oSnr = oSheet.getScenarios()
oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
oCellRangeAddr = oCellRange.getRangeAddress()
oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を作成しました。"
msgbox(oDisp, 0, "Scenario")
'
' Scenarioの削除
oSnr.removeByName(oSnrName)
oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を削除しました。"
msgbox(oDisp , 0,"Scenario")
End Sub
'
' [ 参考 ]
' シナリオの作成方法はようこそ Cafi Net カフィネットへのBlog Pageに詳しく記されています。
Sub CalcScenario()
Dim oDoc As Object
Dim oSheet as Object
Dim oSnr as Object
Dim oCellRange as Object, oCellRangeAddr as Object
Dim oSnrName as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("Sheet1")
' 前準備
oSheet.getCellByPosition(0,0).String = "定価"
oSheet.getCellByPosition(0,1).String = "割引率"
oSheet.getCellByPosition(0,2).String = "税金"
oSheet.getCellByPosition(0,3).String = "送料"
oSheet.getCellByPosition(0,4).String = "購入価格"
'
oSheet.getCellByPosition(1,0).Value = 10000
oSheet.getCellByPosition(1,1).Value = 0.1
oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
oSheet.getCellByPosition(1,3).Value = 500
oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
'
' Scenario作成 ( シナリオ1 )
oSnrName = "Scenario_1"
oSnr = oSheet.getScenarios()
oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
oCellRangeAddr = oCellRange.getRangeAddress()
oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
'
' Scenario の各種設定
Dim oSnrObj as Object
Dim oSnrShow as Boolean, oSnrPct as Boolean, oSnrPrtBrdr as Boolean, oSnrCyBk as Boolean, oSnrCpStyle as Boolean, oSnrCpFormula as Boolean
oSnrObj = oSnr.getByName(oSnrName)
if oSnrObj.IsActive = true then
oSnrObj.BorderColor = RGB(0,255,0) ' 色によっては 削除時にError が発生( 理由不明 )
oSnrPct = oSnrObj.Protected
oSnrShow = oSnrObj.ShowBorder
oSnrPrtBrdr = oSnrObj.PrintBorder
oSnrCyBk = oSnrObj.CopyBack
oSnrCpStyle = oSnrObj.CopyStyles
oSnrCpFormula = oSnrObj.CopyFormulas
oDisp = "oSnrPct = " & oSnrPct & Chr$(10) & "oSnrShow = " & oSnrShow & Chr$(10) & _
"oSnrPrtBrdr = " & oSnrPrtBrdr & Chr$(10) & "oSnrCyBk = " & oSnrCyBk & Chr$(10) & _
"oSnrCpStyle = " & oSnrCpStyle & Chr$(10) & "oSnrCpFormula = " & oSnrCpFormula
end if
msgbox(oDisp, 0, "Scenario") ' msgbox を移動させると 削除時に Errorが発生
'
' Scenarioの削除
oSnrObj.Protected = false
oSnr.removeByName(oSnrName)
oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を削除しました。"
msgbox(oDisp , 0,"Scenario")
End Sub
Sub CalcScenario()
Dim oDoc As Object
Dim oSheet as Object
Dim oSnr as Object
Dim oCellRange as Object, oCellRangeAddr as Object
Dim oSnrName as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("Sheet1")
' 前準備
oSheet.getCellByPosition(0,0).String = "定価"
oSheet.getCellByPosition(0,1).String = "割引率"
oSheet.getCellByPosition(0,2).String = "税金"
oSheet.getCellByPosition(0,3).String = "送料"
oSheet.getCellByPosition(0,4).String = "購入価格"
'
oSheet.getCellByPosition(1,0).Value = 10000
oSheet.getCellByPosition(1,1).Value = 0.1
oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
oSheet.getCellByPosition(1,3).Value = 500
oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
'
' Scenario作成 ( シナリオ1 )
oSnrName = "Scenario_1"
oSnr = oSheet.getScenarios()
oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
oCellRangeAddr = oCellRange.getRangeAddress()
oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "これはシナリオのコメント")
'
' Scenario のComment取得
Dim oSnrCmt as String
oSnrObj = oSnr.getByName(oSnrName)
oSnrCmt = oSnrObj.getScenarioComment()
oDisp = "[ Comment ]" & Chr$(10) & oSnrCmt
'
' Commentの変更
oSnrObj.setScenarioComment("変更したコメント")
oSnrCmt = oSnrObj.getScenarioComment()
oDisp = oDisp & Chr$(10) & Chr$(9) & "↓" & Chr$(10) & oSnrCmt
msgbox(oDisp, 0, "Scenario")
'
' Scenarioの削除
oSnrObj.Protected = false
oSnr.removeByName(oSnrName) 'たまに、 原因不明の Error が生じる事がある。
oDisp = "シナリオ名 : " & oSnrName & Chr$(10) & "を削除しました。"
msgbox(oDisp , 0,"Scenario")
End Sub
Sub CalcScenario()
Dim oDoc As Object
Dim oSheet as Object
Dim oSnr as Object
Dim oCellRange as Object, oCellRangeAddr as Object
Dim oSnrName as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("Sheet1")
' 前準備
oSheet.getCellByPosition(0,0).String = "定価"
oSheet.getCellByPosition(0,1).String = "割引率"
oSheet.getCellByPosition(0,2).String = "税金"
oSheet.getCellByPosition(0,3).String = "送料"
oSheet.getCellByPosition(0,4).String = "購入価格"
'
oSheet.getCellByPosition(1,0).Value = 10000
oSheet.getCellByPosition(1,1).Value = 0.1
oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
oSheet.getCellByPosition(1,3).Value = 500
oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
'
' Scenario作成 ( シナリオ1 )
oSnrName = "Scenario_1"
oSnr = oSheet.getScenarios()
oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
oCellRangeAddr = oCellRange.getRangeAddress()
oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
'
oDisp = "Scenarioの有無" & Chr$(10) & " → " & oSnr.hasElements()
msgbox(oDisp, 0, "Scenario作成")
'
' Scenarioの削除
oSnr.removeByName(oSnrName)
oDisp = "Scenarioの有無" & Chr$(10) & " → " & oSnr.hasElements()
msgbox(oDisp , 0,"Scenario削除")
End Sub
Sub CalcScenario()
Dim oDoc As Object
Dim oSheet as Object
Dim oSnr as Object
Dim oCellRange as Object, oCellRangeAddr as Object
Dim oSnrName as String, oSnrName2 as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("Sheet1")
' 前準備
oSheet.getCellByPosition(0,0).String = "定価"
oSheet.getCellByPosition(0,1).String = "割引率"
oSheet.getCellByPosition(0,2).String = "税金"
oSheet.getCellByPosition(0,3).String = "送料"
oSheet.getCellByPosition(0,4).String = "購入価格"
'
oSheet.getCellByPosition(1,0).Value = 10000
oSheet.getCellByPosition(1,1).Value = 0.1
oSheet.getCellByPosition(1,2).Formula = "= $B$1*(1-$B$2) * 0.05"
oSheet.getCellByPosition(1,3).Value = 500
oSheet.getCellByPosition(1,4).Formula = "= $B$1 * (1- $B$2) + $B$3 + $B$4"
'
' Scenario作成 ( シナリオ1 )
oSnrName = "Scenario_1"
oSnr = oSheet.getScenarios()
oCellRange = oSheet.getCellRangeByPosition(1,0,1,4)
oCellRangeAddr = oCellRange.getRangeAddress()
oSnr.addNewByName( oSnrName, Array(oCellRangeAddr), "Commnet")
'
oSnrName2 = "Scenario_2"
oDisp = "[ Scenarioの有無 ]" & Chr$(10) & oSnrName & " → " & oSnr.hasByName(oSnrName) & Chr$(10) & _
oSnrName2 & " → " & oSnr.hasByName(oSnrName2)
msgbox(oDisp, 0, "Scenario作成")
'
' Scenarioの削除
oSnr.removeByName(oSnrName) ' 時々Error発生
oDisp = "[ Scenarioの有無 ]" & Chr$(10) & oSnrName & " → " & oSnr.hasByName(oSnrName) & Chr$(10) & _
oSnrName2 & " → " & oSnr.hasByName(oSnrName2)
msgbox(oDisp , 0,"Scenario削除")
End Sub
Graph Chart作成
Sub oSimple_Chart
Dim oRange As Object
Dim oSheet As Object
Dim oCharts As Object
Dim oChart_Line As Object
Dim oTitle As String
Dim oRect As New com.sun.star.awt.Rectangle
Dim oRangeAddress(1) As New com.sun.star.table.CellRangeAddress
oDoc=ThisComponent
oTitle="Simple Chart"
oRect.Height=5000 'Unit : 1/100mm
oRect.Width=10000 'Unit : 1/100mm
oRect.x = 5000 'Unit : 1/100mm
oRect.y = 5000 'Unit : 1/100mm
oRange=oDoc.getCurrentSelection.getRangeAddress
oSheet=oDoc.CurrentSelection.getSpreadsheet
oCharts=oSheet.Charts
'Set Y axis Data
oRangeAddress(1).sheet = oRange.Sheet
oRangeAddress(1).StartColumn = oRange.StartColumn
oRangeAddress(1).EndColumn = oRange.EndColumn
oRangeAddress(1).StartRow = oRange.StartRow
oRangeAddress(1).EndRow = oRange.EndRow
'Set X axis Data
oRangeAddress(0).sheet = oRange.Sheet
oRangeAddress(0).StartColumn = oRange.StartColumn+1
oRangeAddress(0).EndColumn = oRange.EndColumn
oRangeAddress(0).StartRow = oRange.StartRow
oRangeAddress(0).EndRow = oRange.EndRow
'同名のChartは消す
if oCharts.hasByName(oTitle) Then
oCharts.RemoveByName(oTitle)
end if
'Draw Chart
oCharts.addNewByName(oTitle,oRect,oRangeAddress(),True,True)
'Chart Title表示
oChart_Line=oCharts.getByName(oTitle).embeddedObject
oChart_Line.HasMainTitle = True
oChart_Line.Title.String = oTitle
'軸Title表示
oChart_Line.diagram.HasXAxisTitle = true
oChart_Line.diagram.XAxisTitle.String = "Data"
oChart_Line.diagram.HasYAxisTitle = true
oChart_Line.diagram.YAxisTitle.String = "Number of Cases"
'X目盛の傾きset
oChart_Line.diagram.XAxis.TextBreak = false
oChart_Line.diagram.XAxis.TextRotation =2700 'Unit: 1/100th of degree
'Chartの種類を変更
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.LineDiagram") '折れ線グラフ
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.AreaDiagram") '折れ線の下範囲に色付きグラフ
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.BarDiagram") '棒グラフ(Default)
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.DonutDiagram") '円グラフ(中心空洞)
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.NetDiagram") '円折れ線グラフ
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.PieDiagram") '円グラフ
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.StackableDiagram") '棒グラフ(="BarDiagram")
'oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.StockDiagram") 'ローソク線
oChart_Line.diagram = oChart_Line.createInstance("com.sun.star.chart.XYkDiagram") '棒グラフ(="BarDiagram")
End Sub
Sub CalcGraph()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:InsertObjectChart", "", 0, Array())
msgbox "Success"
End Sub
Sub CalcGraph()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:DrawChart", "", 0, Array())
msgbox "Success"
End Sub
画像
Sub oInsertPic
Dim document as Object
Dim dispather as Object
oDoc = ThisComponent
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' ファイル選択ダイアログの初期化
Dim oFilePickerDlg as Object
oFilePickerDlg = createUnoService("com.sun.star.ui.dialogs.FilePicker")
oFilePickerDlg.appendFilter("JPEG画像ファイル(*.jpg, *.jpeg)", "*.jpg", "*.jpeg")
If oFilePickerDlg.execute = 1 then
'ファイルが指定された場合
Dim selFiles() as String
selFiles() = oFilePickerDlg.getFiles()
Dim picInfo(2) as new com.sun.star.beans.PropertyValue
picInfo(0).Name = "FileName"
picInfo(0).Value = selFiles(0)
picInfo(1).Name = "FilterName"
picInfo(1).Value = "JPEG - Joint Photograhpic Experts Group"
picInfo(2).Name = "AsLink"
picInfo(2).Value = false
'ダイアログで指定された画像をアクティブセルへ挿入
dispatcher.executeDispatch(document, ".uno:InsertGraphic","", 0, picInfo())
End if
End Sub
'
' [ Note ]
BMP : Windows Bitmap
DXF : AutoCad Interchange Format
EMF : Enhanced Metafile
EPS : Encapsulated PostScript
GIF : Graphics Interface Format
JPEG : Joint Photographic Experts Group
MET : OS/2 Metafile
PBM : Portable Bitmap
PCD : Kodac Photo CD
PCT : Mac Pict
PCX : Zsoft Paintbrush
PGM : Portable Graymap
PNG : Portable Network Graphics
PPM : Portable Pixelmap
PSD : Adobe Photoshop
RAS : Sun Raster Image
SGF : StarWriter Graphic Format
SGV : StarDraw
SVM : StarView
TGA : Truevision
TIFF : Tagged Image File Format
WMF : Windows Metafile Format
XBM : X Bitmap
XPM : X Pixmap
印刷操作
Sub oPage_Break()
Dim oDoc as Object, oSheet as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oSheet.Rows(9).IsStartOfNewPage = true '10行目の前(9行目の後)に改Pageを設定
msgbox "改Page( 行 )設定",0,"改Page"
'
oSheet.Rows(9).IsStartOfNewPage = false
msgbox "改Page( 行 )解除",0,"改Page"
'
oSheet.Columns(1).IsStartOfNewPage = true ' B列の前に改Page設定
msgbox "改Page( 列 )設定",0,"改Page"
'
oSheet.Columns(1).IsStartOfNewPage = false
msgbox "改Page( 列 )解除",0,"改Page"
End Sub
Sub oPage_Break()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp(0).Name = "ToPoint"
oProp(0).Value = "9:9" '10行目の前(9行目の後)に改Pageを設定
oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch( oFrame, ".uno:InsertRowBreak", "", 0, Array()) ' InsertRowbreak 不可
msgbox "改Page( 行 )設定",0,"改Page"
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "9:9" ' 毎回選択が必要
oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch( oFrame, ".uno:DeleteRowbreak", "", 0, Array()) ' DeleteRowBreak 不可
msgbox "改Page( 行 )解除",0,"改Page"
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B:B" ' B列の前に改Page設定
oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch( oFrame, ".uno:InsertColumnBreak", "", 0, Array())
msgbox "改Page( 列 )設定",0,"改Page"
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B:B"
oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch( oFrame, ".uno:DeleteColumnbreak", "", 0, Array())
msgbox "改Page( 列 )解除",0,"改Page"
End Sub
Sub oPrintArea
Dim oPrintArea(0) as new com.sun.star.table.CellRangeAddress
Dim oprops ' com.sun.star.table.CellRangeAddress
Dim oDummy()
On Error Goto oBad
sName = "c:\temp\oDocProp.ods"
sURL = ConvertToUrl(sName)
oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
oSheet = oDoc.Sheets(0)
ouno = "com.sun.star.sheet.XPrintAreas"
'set Print Area
oPrintArea(0).StartColumn = 0
oPrintArea(0).StartRow = 0
oPrintArea(0).EndColumn = 9
oPrintArea(0).EndRow = 9
oDoc.Sheets(0).setPrintAreas( oPrintArea())
'Store
Dim oStore(0) as new com.sun.star.beans.PropertyValue
oStore(0).name = "Overwrite"
oStore(0).Value = true
oDoc.storeAsURL(sURL, oStore())
wait(10)
'get Print Area
If HasUnoInterfaces(oSheet, ouno) then
oprops = oSheet.getPrintAreas()
oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
oDisp = oDisp & "Sheet No" & Chr$(9) & Chr$(9) & " = " & oprops(0).Sheet & Chr$(10)
oDisp = oDisp & "Start Column " & Chr$(9) & " = " & oprops(0).StartColumn & Chr$(10)
oDisp = oDisp & "End Column " & Chr$(9) & Chr$(9) & " = " & oprops(0).EndColumn & Chr$(10)
oDisp = oDisp & "Start Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).StartRow & Chr$(10)
oDisp = oDisp & "End Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).EndRow & Chr$(10)
msgbox(oDisp,0,"Print Area")
else
msgbox("This Document does not support" & Chr$(10) & _
"the XPrintAreas interface",0,"Caution!!")
end If
oDoc.dispose
Exit sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
oDoc.dispose
End Sub
Sub oPrintTitle
Dim oPrintArea(0) as new com.sun.star.table.CellRangeAddress
Dim oprops ' com.sun.star.table.CellRangeAddress
Dim oDummy()
On Error Goto oBad
sName = "c:\temp\oDocProp.ods"
sURL = ConvertToUrl(sName)
oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
oSheet = oDoc.Sheets(0)
ouno = "com.sun.star.sheet.XPrintAreas"
'set
oDoc.Sheets(0).setPrintTitleColumns( true)
'Store
Dim oStore(0) as new com.sun.star.beans.PropertyValue
oStore(0).name = "Overwrite"
oStore(0).Value = true
oDoc.storeAsURL(sURL, oStore())
wait(10)
'get Print Area
If HasUnoInterfaces(oSheet, ouno) then
oprops = oSheet.getPrintTitleColumns()
oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
oDisp = "Print Title for Columns => "
oDIsp = oDisp & oprops
msgbox(oDisp,0,"Print Title")
else
msgbox("This Document does not support" & Chr$(10) & _
"the XPrintAreas interface",0,"Caution!!")
end If
oDoc.dispose
Exit sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
oDoc.dispose
End Sub
Sub oPrintTitle
Dim oTitleArea(0) as new com.sun.star.table.CellRangeAddress
Dim oprops ' com.sun.star.table.CellRangeAddress
Dim oDummy()
On Error Goto oBad
sName = "c:\temp\oDocProp.ods"
sURL = ConvertToUrl(sName)
oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
oSheet = oDoc.Sheets(0)
ouno = "com.sun.star.sheet.XPrintAreas"
'set
oTitleArea(0).StartColumn = 0
oTitleArea(0).StartRow = 0
oTitleArea(0).EndColumn = 15
oTitleArea(0).EndRow = 20
oSheet.setTitleColumns( oTitleArea(0))
'Store
Dim oStore(0) as new com.sun.star.beans.PropertyValue
oStore(0).name = "Overwrite"
oStore(0).Value = true
oDoc.storeAsURL(sURL, oStore())
wait(10)
'get Print Area
If HasUnoInterfaces(oSheet, ouno) then
oprops = oSheet.getTitleColumns()
oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
' oDisp = "Print Title for Rows => "
' oDIsp = oDisp & oprops
oDisp = oDisp & "Sheet No" & Chr$(9) & Chr$(9) & " = " & oprops(0).Sheet & Chr$(10)
oDisp = oDisp & "Start Column " & Chr$(9) & " = " & oprops(0).StartColumn & Chr$(10)
oDisp = oDisp & "End Column " & Chr$(9) & Chr$(9) & " = " & oprops(0).EndColumn & Chr$(10)
' oDisp = oDisp & "Start Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).StartRow & Chr$(10)
' oDisp = oDisp & "End Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).EndRow & Chr$(10)
msgbox(oDisp,0,"Print Title")
else
msgbox("This Document does not support" & Chr$(10) & _
"the XPrintAreas interface",0,"Caution!!")
end If
oDoc.dispose
Exit sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
oDoc.dispose
End Sub
Sub oPrintTitle
Dim oPrintArea(0) as new com.sun.star.table.CellRangeAddress
Dim oprops ' com.sun.star.table.CellRangeAddress
Dim oDummy()
On Error Goto oBad
sName = "c:\temp\oDocProp.ods"
sURL = ConvertToUrl(sName)
oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
oSheet = oDoc.Sheets(0)
ouno = "com.sun.star.sheet.XPrintAreas"
'set
oDoc.Sheets(0).setPrintTitleRows( true)
'Store
Dim oStore(0) as new com.sun.star.beans.PropertyValue
oStore(0).name = "Overwrite"
oStore(0).Value = true
oDoc.storeAsURL(sURL, oStore())
wait(10)
'get Print Area
If HasUnoInterfaces(oSheet, ouno) then
oprops = oSheet.getPrintTitleRows()
oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
oDisp = "Print Title for Rows => "
oDIsp = oDisp & oprops
msgbox(oDisp,0,"Print Title")
else
msgbox("This Document does not support" & Chr$(10) & _
"the XPrintAreas interface",0,"Caution!!")
end If
oDoc.dispose
Exit sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
oDoc.dispose
End Sub
Sub oPrintTitle
Dim oTitleArea(0) as new com.sun.star.table.CellRangeAddress
Dim oprops ' com.sun.star.table.CellRangeAddress
Dim oDummy()
On Error Goto oBad
sName = "c:\temp\oDocProp.ods"
sURL = ConvertToUrl(sName)
oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
oSheet = oDoc.Sheets(0)
ouno = "com.sun.star.sheet.XPrintAreas"
'set
oTitleArea(0).StartColumn = 0
oTitleArea(0).StartRow = 0
oTitleArea(0).EndColumn = 15
oTitleArea(0).EndRow = 20
oSheet.setTitleRows( oTitleArea(0))
'Store
Dim oStore(0) as new com.sun.star.beans.PropertyValue
oStore(0).name = "Overwrite"
oStore(0).Value = true
oDoc.storeAsURL(sURL, oStore())
wait(10)
'get Print Area
If HasUnoInterfaces(oSheet, ouno) then
oprops = oSheet.getTitleRows()
oDisp = "[ " & sName & " ]" & Chr$(10) & Chr$(10)
' oDisp = "Print Title for Rows => "
' oDIsp = oDisp & oprops
oDisp = oDisp & "Sheet No" & Chr$(9) & Chr$(9) & " = " & oprops(0).Sheet & Chr$(10)
' oDisp = oDisp & "Start Column " & Chr$(9) & " = " & oprops(0).StartColumn & Chr$(10)
' oDisp = oDisp & "End Column " & Chr$(9) & Chr$(9) & " = " & oprops(0).EndColumn & Chr$(10)
oDisp = oDisp & "Start Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).StartRow & Chr$(10)
oDisp = oDisp & "End Row " & Chr$(9) & Chr$(9) & " = " & oprops(0).EndRow & Chr$(10)
msgbox(oDisp,0,"Print Title")
else
msgbox("This Document does not support" & Chr$(10) & _
"the XPrintAreas interface",0,"Caution!!")
end If
oDoc.dispose
Exit sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
oDoc.dispose
End Sub
Sub PrintArea()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
' 改Page設定
oSheet = oDoc.getSheets().getByIndex(0)
oSheet.Rows(5).IsStartOfNewPage = true ' 6行目の前(5行目の後)に改ページを設定
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1:C10"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:DeletePrintArea", "", 0, oProp())
' Row Title 設定
oProp(0).Name = "PrintRepeatRow"
oProp(0).Value = "1:1"
oDispatcher.executeDispatch(oFrame, ".uno:ChangePrintArea", "", 0, oProp())
'
msgbox "Success"
End Sub
'
' [ Note ]
' "PrintRepeatCol" は設定不可
Sub oPrintScale
Dim oPstyleName
Dim oStyle
Dim oDummy()
On Error Goto oBad
sName = "c:\temp\oDocProp.ods"
sURL = ConvertToUrl(sName)
oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
oPstyleName = oDoc.CurrentController.getActiveSheet().PageStyle
oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPstyleName)
oStyle.PageScale = 80 ' <= 80%
'Print out
oDoc.Print(Array())
'close
oDoc.dispose
Exit sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
oDoc.dispose
End Sub
Sub HeaderFooter()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:EditHeaderAndFooter", "", 0, Array())
End Sub
'
' [ Note ]
' Calcのみ。Writerでは動作しない
' 書式 → Page → Header/Footer
' LO4.0.1 の UI からはHeadr or Footerの何れかのDialogのみだが、
' 上記Codeで表示されるDialogではheader/Footerが1つのDialogのTab Page区切りで設定出来る
[ Prinetr ]
Sub CalcSheetStting()
Dim oDoc as Object
Dim oSpdSht as Object
Dim oPrtName as String
oDoc = ThisComponent
oSpdSht = oDoc.createInstance("com.sun.star.comp.SpreadsheetSettings")
oPrtName = oSpdSht.PrinterName
oDisp = "[ Default Printer Name ]" & Chr$(10) & oPrtName
'
msgbox oDisp, 0, "Printer"
End Sub
file操作
Sub oCalcOpen_Dummy
dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oAns = Msgbox("ファイルを閉じますか?",4, "File Close確認")
if oAns = 6 then
oDoc.dispose
End if
End Sub
Sub oCalcOpen_Save
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, Dummy())
oAns = Msgbox("fileを保存しますか?",4, "File Save確認")
if oAns = 6 then
oInp = InputBox("Full pathでFile nameを入力して下さい(例 ： C:\temp\btest.ods)","保存File nameの入力")
If NOT IsNull(oInp) then
oCName = ConvertToUrl(oInp)
oDoc.storeAsURL(oCName, Dummy())
End If
End If
oAnsC = MsgBox("Fileを閉じますか?",4,"Fileの終了確認")
If oAnsC = 6 then
oDoc.dispose
End If
End Sub
Sub oCalcOpen_Name
Dim Dummy()
oName = "c:\temp\test.ods"
oUrl = ConvertToURL(oName)
oDoc = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, Dummy())
oAns = Msgbox("ファイルを閉じますか?",4, "File Close確認")
if oAns = 6 then
oDoc.dispose
End if
End Sub
Sub oCalcOpen_CSV
Dim oDoc as Object
Dim oName as String
Dim oUrl as String
Dim oCSV(1) As New com.sun.star.beans.PropertyValue
oName = "c:\OOo_Macro.csv"
oUrl = ConvertToURL(oName)
oCSV(0).Name = "FilterName"
oCSV(0).Value = "scalc: Text - txt - csv (StarCalc)"
oCSV(1).Name = "FilterOptions"
oCSV(1).Value = "44/32,34,0,1,1/2/2/3/2/4/2"
oDoc = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, oCSV())
End Sub
'
'[ Note ] : ASCII Value,Text Portion,CharactorSet(Default:0),1(Field_Num)/Format/2/Format/･･･/10/Format
'[ ASCII_Value ]
' 44 : Comma(,)
' 32 : Space
' 9 : Tab
'[ Format ]
' 1 : Standard
' 2 : Text
' 3 : MM/DD/YY
' 4 : DD/MM/YY
' 5 : YY/MM/DD
' 9 : Do not Import
' 10 : Format in the US-English locale regardless of the current locale.
Sub oCalcOpen()
Dim oDoc as Object
Dim oFileName as String
Dim oFileUrl as String
Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
oFileName = "c:\temp\CalcTest01.html"
oFileUrl = ConvertToURL(oFileName)
oFilterName(0).Name = "FilterName"
oFilterName(0).Value = "scalc: calc_HTML_WebQuery"
oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub
'
' [ Note ]
' calc_HTML_WebQueryはImportのみ
' HTML(StarCalc) ではWriterが起動
Sub oCalcOpen()
Dim oDoc as Object
Dim oFileName as String
Dim oFileUrl as String
Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
oFileName = "c:\temp\CalcTest01.slk"
oFileUrl = ConvertToURL(oFileName)
oFilterName(0).Name = "FilterName"
oFilterName(0).Value = "scalc: SYLK"
oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub
Sub oCalcOpen()
Dim oDoc as Object
Dim oFileName as String
Dim oFileUrl as String
Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
oFileName = "c:\temp\Excel2003Test.xls"
oFileUrl = ConvertToURL(oFileName)
oFilterName(0).Name = "FilterName"
oFilterName(0).Value = "scalc: MS Excel 2003"
oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub
Sub oCalcOpen()
Dim oDoc as Object
Dim oFileName as String
Dim oFileUrl as String
Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
oFileName = "c:\temp\Excel2007Test.xlsx"
oFileUrl = ConvertToURL(oFileName)
oFilterName(0).Name = "FilterName"
oFilterName(0).Value = "scalc: MS Excel 2007"
oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub
Sub oCalcOpen()
Dim oDoc as Object
Dim oFileName as String
Dim oFileUrl as String
Dim oFilterName(0) As New com.sun.star.beans.PropertyValue
oFileName = "c:\temp\CalcTest01.xml"
oFileUrl = ConvertToURL(oFileName)
oFilterName(0).Name = "FilterName"
oFilterName(0).Value = "scalc: MS Excel 2003 XML"
oDoc = StarDesktop.loadComponentFromURL(oFileUrl, "_blank", 0, oFilterName())
End Sub
CSV file操作
Sub oCSV
On Error Goto oBad
Dim oCSVFile as String
Dim oVal(10,10) as Long
Dim i, j as Integer
Dim n as Integer
n = 0
for i = 0 to 10
for j = 0 to 10
oVal(i,j) = n
n = n + 1
next j
next i
'
oCSVFile = "C:\Temp\OOoTest.csv"
Open oCSVFile For Output As #1
for j = 0 to 10
oDisp = ""
for i = 0 to 10
oDisp = oDisp & oVal(i, j) & ","
next i
Print #1,oDisp
next j
'
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
Web関係
Sub Excel_Save Dim oUrl as String
Dim oDoc as Object
Dim oPropertyValue(0) As New com.sun.star.beans.PropertyValue
Dim document as object Dim dispatcher as object
Dim args1(1) as new com.sun.star.beans.PropertyValue
icompany_symbol="GOOG"
oUrl="http://ichart.finance.yahoo.com/table.csv" & "?s=" & icompany_symbol & "&e=.csv"
oPropertyValue(0).Name="FilterOptions"
oPropertyValue(0).Value="44"
oDoc=starDeskTop.LoadComponentFromURL( oUrl, "_blank", 0, oPropertyValue)
document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
args1(0).Name = "Filename"
args1(0).Value = "C:\Google_Stock.xls"
args1(1).Name = "FilterOprtion"
args1(1).Value = "MS Excel 97"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
oDoc.close(false)
End Sub
Sub YahooStock()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp1(2) as new com.sun.star.beans.PropertyValue
Dim oUrl as String, oSymbol as String
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oSymbol = "GOOG" ' Google
oUrl = "http://finance.yahoo.com/q/hp?s=" & oSymbol & "+Historical+Prices"
'
oProp1(0).Name = "FileName"
oProp1(0).Value = oUrl
oProp1(1).Name = "FilterName"
oProp1(1).Value = "calc_HTML_WebQuery"
oProp1(2).Name = "Source"
oProp1(2).Value = "HTML_14"
oDispatcher.executeDispatch(oFrame, ".uno:InsertExternalDataSource", "", 0, oProp1())
'
msgbox "Success"
End Sub
･その他
Sub Main
Dim oDoc As object
Dim oDescriptor as Object
Dim oFound as Object
dim args1(0) as new com.sun.star.beans.PropertyValue
dim document as object
dim dispatcher as object
dim args2(0) as new com.sun.star.beans.PropertyValue
document = ThisComponent.CurrentController.Frame
documentView = ThisComponent.CurrentController
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDoc=ThisComponent
oSheets1 = oDoc.Sheets
oSheetcount = oSheets1.getcount() 'sheet数を数える
for i=0 to oSheetcount-1
oSheet=oDoc.Sheets(i)
args2(0).Name = "Nr"
args2(0).Value = i +1 'sheet番号
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args2())
args1(0).Name = "Sel"
args1(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args1())
ActiveColumn=oDoc.CurrentController.getSelection().RangeAddress.StartColumn
ActiveRow=oDoc.CurrentController.getSelection().RangeAddress.StartRow
for j=0 to ActiveColumn
for k=0 to ActiveRow
if oSheet.getCellByPosition(j,k).CellBackColor=RGB(255,0,0) then '全シートのcellの背景がｒｅｄの数を調べる
Red_Count=Red_Count+1
end if
next k
next j
next i
print Red_Count
End Sub
Sub Main
Url = "file:///C:\TEST\2-1-2_OOo_ブックを開く\読込みパスワード.xls"
FileProperties(0).Name = "Password"
FileProperties(0).Value ="nck1"
Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, FileProperties())
End Sub
