:::
OOo使用者討論區

【分享巨集】列出各工作表名稱與建立連結

discuss pic 2018-01-20 17:27:29
功能說明:在第一個工作表中列出第二至第N個工作表的工作表名稱與建立連結

Sub reget_worksheet_name

Dim my_cell as Object
Dim oSheets 
'As com.sun.star.sheet.XSpreadsheet
dim document   as Object
dim dispatcher as object
Dim i
my_doc = ThisComponent
oSheets = ThisComponent.getSheets()
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
dim args2(0) as new com.sun.star.beans.PropertyValue
dim args3(4) as new com.sun.star.beans.PropertyValue
'清除 A欄資料
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$B$1000"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:ClearContents", "", 0, Array())
'msgbox "暫停"
Wait 1000
'更新資料
for i = 1 to osheets.getcount() - 1
'填入各工作表名稱
args1(0).Name = "ToPoint"
args1(0).Value = "$A$" & i
'msgbox args1(0).Value
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
args2(0).Name = "StringName"
args2(0).Value = ThisComponent.Sheets(i).name
'msgbox args2(0).Value
dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args2())

'製作連結
args1(0).Name = "ToPoint"
args1(0).Value = "$B$" & i
'msgbox args1(0).Value
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
args3(0).Name = "Hyperlink.Text"
args3(0).Value = "#連結"
args3(1).Name = "Hyperlink.URL"
args3(1).Value = "#" &  ThisComponent.Sheets(i).name
args3(2).Name = "Hyperlink.Target"
args3(2).Value = ""
args3(3).Name = "Hyperlink.Name"
args3(3).Value = ""
args3(4).Name = "Hyperlink.Type"
args3(4).Value = 1
dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args3())

next i
'排序
sort_data()
'游標歸位
args1(0).Name = "ToPoint"
args1(0).Value = "$C$1"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

End Sub




sub sort_data
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(8) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ByRows"
args1(0).Value = true
args1(1).Name = "HasHeader"
args1(1).Value = false
args1(2).Name = "CaseSensitive"
args1(2).Value = false
args1(3).Name = "NaturalSort"
args1(3).Value = false
args1(4).Name = "IncludeAttribs"
args1(4).Value = true
args1(5).Name = "UserDefIndex"
args1(5).Value = 0
args1(6).Name = "Col1"
args1(6).Value = 1
args1(7).Name = "Ascending1"
args1(7).Value = true
args1(8).Name = "IncludeComments"
args1(8).Value = false

dispatcher.executeDispatch(document, ".uno:DataSort", "", 0, args1())

end sub