OOobbs3/22
質問
お世話になります。 以前に「 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
質問中の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. 感想,コメント,メモ
|