Top > OOobbs2 > 55

OOobbs2/55 Edit

  • サマリ: 値だけコピーしたい
  • 環境: Calc
  • 状態: 解決
  • 投稿者: AMERI?
  • 投稿日: 2007-07-30 (月) 14:51:55

質問 Edit

たとえば、("A1:B5")の範囲の値を("C6:D10")にコピーするとき、コピー先には値だけコピーして、書式設定(たとえばセルの色とか、フォントサイズとか)は変えたくないのですが、どうすればよいでしょうか。oSheet.copyRange( aCellAddress, aCellRangeAddress )では書式設定もコピーされてしまいました。

回答 Edit

  • 値だけコピーするには、
  1. マクロの記録のようにコピーして「形式を選択して貼り付け」で書式以外を貼り付ける
  2. For 文などで行う

この二つのどちらかです。

1 の場合だと、

  1. コピー元のセルを選択、コピー
  2. コピー先のセルを選択、「形式を選択して貼り付け」

選択するのが面倒ですが

Sub Main
Dim oDoc As Object, oController As Object
Dim oFrame As Object
Dim oSheet As Object

  oDoc = ThisComponent
  oController = oDoc.CurrentController
  oFrame = oController.Frame
  
  oSheet = oDoc.getSheets().getByIndex(0)
  
  Dim aSource As New com.sun.star.table.CellRangeAddress
  With aSource
    .Sheet = 0
    .StartColumn = 0
    .StartRow = 0
    .EndColumn = 1
    .EndRow = 4
  End With
  
  Dim aDest As New com.sun.star.table.CellAddress
  With aDest
    .Sheet = 0
    .Column = 2
    .Row = 5
  End With
  
  oSourceRange = GetCellRangeFromAddress( oSheet, aSource )
  oDestRange = GetCellFromAddress( oSheet, aDest )

  Dim args(5) as new com.sun.star.beans.PropertyValue
  args(0).Name = "Flags"
  args(0).Value = "SVDF"
  args(1).Name = "FormulaCommand"
  args(1).Value = 0
  args(2).Name = "SkipEmptyCells"
  args(2).Value = false
  args(3).Name = "Transpose"
  args(3).Value = false
  args(4).Name = "AsLink"
  args(4).Value = false
  args(5).Name = "MoveMode"
  args(5).Value = 4

  oController.select(oSourceRange)
  DispatchWithArgs(".uno:Copy",oFrame,array())
  oController.select(oDestRange)
  
  DispatchWithArgs(".uno:InsertContents",oFrame, args())
End Sub


Function GetCellRangeFromAddress( _
  oLocSheet As Object, _
  aLocCellRangeAddress As com.sun.star.table.CellRangeAddress ) As Object
  With aLocCellRangeAddress
    GetCellRangeFromAddress = oLocSheet.getCellRangeByPosition( _
      .StartColumn, .StartRow, .EndColumn, .EndRow )
  End With
End Function

Function GetCellFromAddress( _
  oLocSheet As Object, _
  aLocCellAddress As com.sun.star.table.CellAddress )
  With aLocCellAddress
    GetCellFromAddress = oLocSheet.getCellByPosition( _
      .Column, .Row )
  End With
End Function


sub DispatchWithArgs( sCommand As String, oLocFrame As Object, aLocProps )
  dim dispatcher as object
  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  dispatcher.executeDispatch(oLocFrame, sCommand, "", 0, aLocProps)
end sub

2 の場合だと、セルに入力されているのが

  • 文字列
  • 数式

を判断する必要があります。OOoBasic/Calc/contenttype 参照。

Sub Main
Dim oDoc As Object, oController As Object
Dim oFrame As Object
Dim oSheet As Object
Dim oCell As Object 

  oDoc = ThisComponent
  oController = oDoc.CurrentController
  oFrame = oController.Frame
  
  oSheet = oDoc.getSheets().getByIndex(0)
  
  oSourceRange = oSheet.getCellRangeByName("A1:B5")
  oDestRange = oSheet.getCellRangeByName("C6:D10")
  
  aSource = oSourceRange.RangeAddress

  For i = 0 To oSourceRange.Columns.Count -1
    For j = 0 To oSourceRange.Rows.Count -1
      oCell = oSourceRange.getCellByPosition( i, j )
      
      Select Case oCell.Type
      Case com.sun.star.table.CellContentType.VALUE
        oDestRange.getCellByPosition( i, j ).Value = oCell.Value
      Case com.sun.star.table.CellContentType.TEXT
        oDestRange.getCellByPosition( i, j ).String = oCell.String
      Case com.sun.star.table.CellContentType.FORMULA
        oDestRange.getCellByPosition( i, j ).Formula = oCell.Formula
      End Select
      
    Next j
  Next i
  
End Sub
  • はにゃ?? 2007-07-30 (月) 16:00:47

感想,コメント,メモ Edit

  • ありがとうございました。コピーしたいセルの数が多い時は1の方法が早いようなので、これでいきます。 -- AMERI? 2007-07-31 (火) 09:46:43


Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup   Help   RSS of recent changes