[РЕШЕНО] Макрос переноса данных с одного листа на другой

Автор Aleksandr H., 12 октября 2015, 21:55

0 Пользователи и 1 гость просматривают эту тему.

Aleksandr H.

Прошу прощения что прошу не помощи, а готовую работу :-[, но напишите за меня, пожалуйста, макрос которые делает следующее:
1. с листа "упак42" копирует строки в которых столбец V не пустой
2. очищает лист "Pak_raport"
3. вставляет данные п1 как текст+форматы на лист "Pak_raport" начиная с А1
4. сортирует лист "Pak_raport" за критериями: Група (столбец А) - по А-Я,
kolej (столбец S) по возростанию
:roll:

Aleksandr H.


Function GetLastUsedRow(oSheet) As Integer
  Dim oCursor
  Dim row as integer
  dim vale
  oCursor = oSheet.createCursor
  oCursor.GotoEndOfUsedArea(True)
  row = oCursor.RangeAddress.EndRow
  vale = oSheet.GetCellByPosition(0,row).getString()
  do while vale = ""  ' ищем строку в столбце А в которой есть данные
  row = row - 1
  vale = oSheet.GetCellByPosition(0,row).getString()
  loop
  GetLastUsedRow = row
End Function

Sub MakeMeHappy()
dim oDoc as object, oSheet as object
dim rowCopy as integer, rowPaste as integer, i as integer
dim CurrCellB as string, CurrCellE as string
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
document   = ThisComponent.CurrentController.Frame
oSheet=thiscomponent.sheets.getByname(thiscomponent.getcurrentcontroller.activesheet.name)
SheetPaste =ThisComponent.Sheets.getByName("Pak_raport")
SheetPaste.ClearContents(1 OR 2 OR 4 OR 8 OR 16 OR 32 OR 64 OR 128 OR 256 OR 512)
rowCopy = GetLastUsedRow(oSheet) ' последняя использованная строка в колонке А
rowPaste = 1
for i = 0 to rowCopy+1
ThisComponent.getCurrentController().setActiveSheet(oSheet)
CurrCellB = oSheet.GetCellByPosition(1,i).getString()
CurrCellE = oSheet.GetCellByPosition(4,i).getString()
if CurrCellB <> "" or CurrCellE = "ПАК-4411" then

dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "A" & i+1 &":S" & i+1
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())' выделили диапазон
set args1 = nothing
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array()) ' скопировали выделение

ThisComponent.getCurrentController().setActiveSheet(SheetPaste)  ' перешли на лист Пак_Рапорт
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "A" & rowPaste ' ячейка в которую вставляем

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2()) ' перейти к ячейке
set args2 = nothing
dim args5(5) as new com.sun.star.beans.PropertyValue
args5(0).Name = "Flags"
args5(0).Value = "SVDT"  ' флаги по которым вставляються значения+формат
args5(1).Name = "FormulaCommand"
args5(1).Value = 0
args5(2).Name = "SkipEmptyCells"
args5(2).Value = false
args5(3).Name = "Transpose"
args5(3).Value = false
args5(4).Name = "AsLink"
args5(4).Value = false
args5(5).Name = "MoveMode"
args5(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args5())  ' вставить диапазон с буфера обмена
set args5 = nothing 
rowPaste = rowPaste + 1  ' увеличить счетчик использованных строк
end if
next i
SortCol(SheetPaste,rowPaste) ' сортировать лист SheetPaste, по диапазону (A1:S_rowPaste)
end sub

Sub SortCol(Sheet as object, rowPaste as integer)
' OOME Third Edition Listing 30. Sort two columns in a Calc sheet.
  Dim oRange
  Dim oSortFields(1) as new com.sun.star.util.SortField
  Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
  REM Set the range on which to sort
  oRange = Sheet.getCellRangeByName("A2:S"&rowPaste+1)
  REM Sort on the first field in the range
  oSortFields(0).Field = 0
  oSortFields(0).SortAscending = True
  oSortFields(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
  REM Sort on the nineteen field in the range
  oSortFields(1).Field = 18
  oSortFields(1).SortAscending = True
  oSortFields(1).FieldType = com.sun.star.util.SortFieldType.NUMERIC
  REM Set the sort fields to use
  oSortDesc(0).Name = "SortFields"
  oSortDesc(0).Value = oSortFields()
  REM Now sort the range!
  oRange.Sort(oSortDesc())
End Sub


tags: Last Used Row, LastUserRow, copy past values+formats, copypast values+formats, copy to another sheet, range selection, sorting data, macro, Range.Sort, ClearContents, ActiveSheet changing