呂理群的部落格

複製一段範圍的儲存格資料到蒐集資料的Sheet中

依Re: Macro CopyRange Copy Cells to another Spreadsheet or fil(20170102查詢)修正為如下：

<code>
Sub TableCopyToData rem 此一程式碼是OK的
  Dim oDocA, oSheetA, oSheetB, Dummy(), oRangeA, targetcell as object
  Dim oDispatcher, oFrameA, c as object
  Dim LastRow as long
  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  oDocA = ThisComponent
  oFrameA = oDocA.CurrentController.Frame
  oSheetA = oDocA.getSheets.getByName("print")
  oRangeA = oSheetA.getCellRangeByName("c8:i10")
  oDocA.CurrentController.Select(oRangeA)
  oDispatcher.executeDispatch(oFrameA, ".uno:Copy", "", 0, Dummy())
  oSheetB = oDocA.getSheets.getByName("data")
  c = oSheetB.createCursor
  c.gotoEndOfUsedArea(false)
  LastRow = c.RangeAddress.EndRow +1
  targetcell= oSheetB.getCellByPosition(1,LastRow)
  oDocA.CurrentController.Select(targetcell)
  oFrameA = oDocA.CurrentController.Frame

  dim args4(5) as new com.sun.star.beans.PropertyValue
  args4(0).Name = "Flags"
  args4(0).Value = "SVD"
  args4(1).Name = "FormulaCommand"
  args4(1).Value = 0
  args4(2).Name = "SkipEmptyCells"
  args4(2).Value = false
  args4(3).Name = "Transpose"
  args4(3).Value = false
  args4(4).Name = "AsLink"
  args4(4).Value = false
  args4(5).Name = "MoveMode"
  args4(5).Value = 6
rem  oDispatcher.executeDispatch(oFrameA, ".uno:Paste", "", 0, args4())  rem 不可使用Paste，因Paste是全部原封不動的貼上(含公式)。
  oDispatcher.executeDispatch(oFrameA, ".uno:InsertContents", "", 0, args4()) 
End Sub
</code>