REM ***** BASIC ***** Sub kakeibo_tutorial Dim oDoc As Object, oSheet As Object Dim oRange As Object Dim aHeader() As String Dim oCell As Object Dim i As Integer Dim oBorderLine1 As New com.sun.star.table.BorderLine Dim oBorderLine2 As New com.sun.star.table.BorderLine Dim oBorderLine3 As New com.sun.star.table.BorderLine Dim oTableBorder As New com.sun.star.table.TableBorder Dim oColumn As Object Dim oLocale As New com.sun.star.lang.Locale Dim nKey As Long Dim oNumberFormats As Object Dim sFormat As String Dim oStyleFamilies As Object Dim oCellStyles As Object Dim oSunStyle As Object, oSatStyle As Object, oNextMonth As Object Dim aNewStyles(2) As Object Dim sNewStyleName(2) As String Dim oConditionalFormat As Object Dim aCondition1(2) As New com.sun.star.beans.PropertyValue Dim aCondition2(2) As New com.sun.star.beans.PropertyValue Dim aCondition3(2) As New com.sun.star.beans.PropertyValue oDoc = ThisComponent oSheet = oDoc.getSheets().getByIndex(0) oRange = oSheet.getCellRangeByName("A1:T50") oRange.CellBackColor = RGB(230,230,255) 'Blue gray aHeader() = Array( "収入", "住居費", "光熱費", "消耗品", _ "教育費", "食費", "嗜好品", "教養娯楽", "衣服", _ "交通費", "その他", "支出計", "残高" ) For i = 0 To 12 oSheet.getCellByPosition( 4 + i, 2 ).String = aHeader(i) Next i oRange = oSheet.getCellRangeByPosition( 4, 2, 14, 2 ) 'Range "E3:O3" With oRange .RotateAngle = 4500 .HoriJustify = com.sun.star.table.CellHoriJustify.CENTER End With With oBorderLine1 .Color = RGB(230, 230, 255) .OuterLineWidth = 2 '0.05 pt End With With oTableBorder .IsLeftLineValid = True .IsRightLineValid = True .IsVerticalLineValid = True .LeftLine = oBorderLine1 .RightLine = oBorderLine1 .VerticalLine = oBorderLine1 End With With oSheet .getCellRangeByPosition( 4, 2, 14, 2 ).CharColor = RGB(230,230,255) .getCellRangeByPosition( 4, 2, 14, 2 ).TableBorder = oTableBorder .getCellByPosition( 4, 2 ).CellBackColor = RGB( 92, 133, 38 ) 'Green 2 .getCellRangeByPosition( 5, 2, 14, 2 ).CellBackColor = _ RGB( 0, 74, 74 ) 'Turquoise 8 .getCellRangeByPosition( 15, 2, 16, 2 ).HoriJustify = _ com.sun.star.table.CellHoriJustify.RIGHT End With oColumn = oSheet.getCellRangeByPosition(0,0,1,0).getColumns() oColumn.Width = 1000 oCell = oSheet.getCellRangeByName("C3") oCell.Value = Month( Now ) sFormat = "0月分" oNumberFormats = oDoc.NumberFormats nKey = oNumberFormats.queryKey( sFormat, oLocale, false ) If nKey <> -1 Then oCell.NumberFormat = nKey Else nKey = oNumberFormats.addNew( sFormat, oLocale ) oCell.NumberFormat = nKey End If oCell.CharHeight = 24 oCell.getColumns().OptimalWidth = true oCell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER oCell = oSheet.getCellRangeByName( "C5" ) oCell.Formula = "=DATE(" & YEAR( NOW ) & ";C3;1)" oSheet.getCellRangeByName( "C6" ).Formula = "=C5+1" oRange = oSheet.getCellRangeByName("C6:C35") oRange.fillAuto( com.sun.star.sheet.FillDirection.TO_BOTTOM, 1 ) oRange = oSheet.getCellRangeByName("C5:C35") nKey = -1 sFormat = "M月D日(AAA)" nKey = oNumberFormats.queryKey( sFormat, oLocale, false ) If nKey <> -1 Then oRange.NumberFormat = nKey Else nKey = oNumberFormats.addNew( sFormat, oLocale ) oRange.NumberFormat = nKey End If oRange.CharHeight = 11 oRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER oStyleFamilies = oDoc.StyleFamilies oCellStyles = oStyleFamilies.getByName("CellStyles") sNewStyleName() = Array( "土曜日", "日曜日", "翌月" ) aNewStyles() = Array( oSatStyle, oSunStyle, oNextMonth ) For i = 0 To 2 If NOT oCellStyles.hasByName(sNewStyleName(i)) Then aNewStyles(i) = oDoc.createInstance("com.sun.star.style.CellStyle") oCellStyles.insertByName( sNewStyleName(i), aNewStyles(i) ) Else oCellStyles.removeByName( sNewStyleName(i) ) aNewStyles(i) = oDoc.createInstance("com.sun.star.style.CellStyle") oCellStyles.insertByName( sNewStyleName(i), aNewStyles(i) ) End If Next i oSatStyle.CellBackColor = RGB( 153, 204, 255 ) oSunStyle.CellBackColor = RGB( 255, 0, 255 ) With oNextMonth .CharColor = RGB(230,230,255) .CellBackColor = RGB(230,230,255) End With oConditionalFormat = oRange.ConditionalFormat aCondition1(0).Name = "Operator" aCondition1(0).Value = com.sun.star.sheet.ConditionOperator.GREATER aCondition1(1).Name = "Formula1" aCondition1(1).Value = "EOMONTH($Sheet1.$C$5;0)" aCondition1(2).Name = "StyleName" aCondition1(2).Value = sNewStyleName(2) aCondition2(0).Name = "Operator" aCondition2(0).Value = com.sun.star.sheet.ConditionOperator.FORMULA aCondition2(1).Name = "Formula1" aCondition2(1).Value = "WEEKDAY(A1)=7" aCondition2(2).Name = "StyleName" aCondition2(2).Value = sNewStyleName(0) aCondition3(0).Name = "Operator" aCondition3(0).Value = com.sun.star.sheet.ConditionOperator.FORMULA aCondition3(1).Name = "Formula1" aCondition3(1).Value = "WEEKDAY(A1)=1" aCondition3(2).Name = "StyleName" aCondition3(2).Value = sNewStyleName(1) With oConditionalFormat .clear() .addNew( aCondition1() ) .addNew( aCondition2() ) .addNew( aCondition3() ) End With oRange.ConditionalFormat = oConditionalFormat With oSheet .getCellRangeByName( "C4" ).String = "前月より" .getCellRangeByName( "C37" ).String = "合計" .getCellRangeByName( "C4:C37" ).HoriJustify = _ com.sun.star.table.CellHoriJustify.CENTER .getCellRangeByName( "P5" ).Formula = "=SUM(F5;O5)" .getCellRangeByName( "Q5" ).Formula = "=Q4+E5-P5" .getCellRangeByName( "E37" ).Formula = "=SUM(E5;E35)" End With oRange = oSheet.getCellRangeByName("P5:P35") oRange.fillAuto( com.sun.star.sheet.FillDirection.TO_BOTTOM, 1 ) oRange = oSheet.getCellRangeByName("Q5:Q35") oRange.fillAuto( com.sun.star.sheet.FillDirection.TO_BOTTOM, 1 ) oRange = oSheet.getCellRangeByName("E37:P37") oRange.fillAuto( com.sun.star.sheet.FillDirection.TO_RIGHT, 1 ) oRange = oSheet.getCellRangeByName("E4:Q37") nKey = oNumberFormats.queryKey( "#,##0", oLocale, false ) If nKey <> -1 Then oRange.NumberFormat = nKey Else nKey = oNumberFormats.addNew( "#,##0", oLocale ) oRange.NumberFormat = nKey End If With oBorderLine2 'white line .Color = RGB(255, 255, 255) 'white .OuterLineWidth = 141 '4 pt End With With oBorderLine3 'gray line .Color = RGB(153, 153, 153) 'gray 40% .OuterLineWidth = 141 '4 pt End With oTableBorder = createUnoStruct("com.sun.star.table.TableBorder") With oTableBorder .IsLeftLineValid = true .IsTopLineValid = true .IsRightLineValid = true .IsBottomLineValid = true .LeftLine = oBorderLine2 .TopLine = oBorderLine2 .RightLine = oBorderLine3 .BottomLine = oBorderLine3 End With oSheet.getCellRangeByName( "B2:R38" ).TableBorder = oTableBorder With oTableBorder .LeftLine = oBorderLine3 .TopLine = oBorderLine3 .RightLine = oBorderLine2 .BottomLine = oBorderLine2 End With oSheet.getCellRangeByName( "E5:O35" ).TableBorder = oTableBorder End Sub |