- サマリ: WriterにおけるＯｕｔｌｉｎｅ設定について
- 環境: Writer
- 状態: 解決
- 投稿者: new_OOo3?
- 投稿日: 2010-09-26 (日) 14:50:58
質問 
お世話になります。
以前に「 OOobbs3/18 」にてご教示頂きましたmacroでのImpressのOutline設定方法とNet検索結果を基に、WriterでもOutlineを設定をするべく下記Codeを作成しましたが、Outline設定ができません。
******** Code( Outline設定 in Writer ) ************
Sub oOutlineInWrite
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
Dim oRules
Dim oRule()
Dim oProp
Dim oNames(0)
oNames(0) = "_New_Heading_1"
oRules = oDoc.getChapterNumberingRules()
For i = 0 To UBound(oNames())
If i >= oRules.getCount() Then Exit Sub
oRule() = oRules.getByIndex(i)
For j = LBound(oRule()) To Ubound(oRule())
oProp = oRule(j)
Select Case oProp.Name
Case "HeadingStyleName"
oProp.Value = oNames(i)
Case "NumberingType"
oProp.Value = com.sun.star.style.NumberingType.ARABIC
Case "ParentNumbering"
oProp.Value = i + 1
Case "Prefix"
oProp.Value = ""
Case "Suffix"
oProp.Value = " "
End Select
oRule(j) = oProp
Next j
oRules.replaceByIndex(i, oRule())
Next i
'
Dim oFamilies
Dim oParaStyles
Dim oStyle
oFamilies = oDoc.StyleFamilies
oParaStyles = oFamilies.getByName("ParagraphStyles")
'
oStyle = oDoc.createInstance("com.sun.star.style.ParagraphStyle")
oStyle.setParentStyle("Heading")
'
oStyle.CharHeight = 20
oParaStyles.insertByName(oNames(0), oStyle)
'
oDText = oDoc.getText()
oDisp = "This line is first paragraph. This is first line." & Chr$(13) & _
"This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line." & Chr$(13) & _
"This line is fourth paragraph. It is fifth line."
oDText.insertString(oDText.getEnd(), oDisp, true)
End Sub
************************************************
[ Macro実行結果 ](質問後の追記)
This line is first paragraph. This is first line.
This line is second paragraph. It is third line.
This line is third paragraph. It is fourth line.
This line is fourth paragraph. It is fifth line.
しかし本来は下記Macro実行結果を得たいと考えております。
[アラビア数字を用いたOutline（箇条書き）]
[ Macro実行結果 ]
1 This line is first paragraph. This is first line.
2 This line is second paragraph. It is third line.
3 This line is third paragraph. It is fourth line.
4 This line is fourth paragraph. It is fifth line.
同じような質問で恐縮ですが宜しくご教示頂けます様お願いします。
回答
Sub InsertOrderedParagraphs
oDoc = ThisComponent
oText = oDoc.getText()
oCursor = nothing
' ここでは定義済みの番号付けスタイル Outline を利用。必要に応じて作成
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
If IsNull(oRule) Then Exit sub
' 番号付けスタイルの表示形式を変更
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.ARABIC
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
' 段落の挿入と段落に番号付けを設定
sLines = Array("1st", "2nd", "3rd")
For i = 0 To UBound(sLines) step 1
oPara = oText.appendParagraph(Array())
oCursor = oText.createTextCursorByRange(oPara)
oText.insertString(oCursor, sLines(i), False)
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
- ご教示ありがとうございました。上手く出来ました。 -- new_OOo3
質問中のCodeでの結果を上記質問中に追記させて頂きました。
また、ご教示頂きました内容を反映したcodeを参考までに以下に記します。
********** 正解 Code *************
Sub oOutlineParagraph
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
' ここでは定義済みの番号付けスタイル Outline を利用。必要に応じて作成
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' 番号付けスタイルの表示形式を変更
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.ARABIC
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
****************************************************************
[ Macro実行結果 ]
1 This line is first paragraph. This is first line.
2 This line is second paragraph. It is third line.
3 This line is third paragraph. It is fourth line.
4 This line is fourth paragraph. It is fifth line.
感想，コメント，メモ
