Kopiowanie wyników autofiltra do innego arkusza

[Dawidxyz]

Witam! Mam pewien problem, myślę że można go jakoś rozwiązać, aczkolwiek to nie na moją głowę.

Mam Autofiltr i wybierając nr klienta a nastepnie kod towaru widze reszte specyfikacji (z góry przepraszam ale musiałem ukryć wszystkie dane)

Klient Towar Specyfikacja Specyfikacja1 Specyfikacja2 Specyfikacja3 Specyfikacja4
1 5 dsadasd oijoh kkllkjl xyz xyz
1 5 dsadasd oijoh kkllkjl xyz xyz
2 5 dsadasd oijoh kkllkjl xyz xyz
2 5 dsadasd oijoh kkllkjl xyz xyz


Wybierając Klienta i dany towar mam już ładnie w jednej linijce pełną specyfikację. Cały myk polega na tym, aby skopiować dane które widzę po użyciu autofiltra. (chodzi o inne rozmieszczenie danych na całej stronie aby było czytelnie i przejrzyście).

Nazwy, czyli klient towar etc są w Wierszu 5. Jakby udało się jakoś skopiować do innego arkusza dane spod wiersza 5. Wiadomo po użyciu autofiltra np pod A5 mam od razu A75, więc formuła =Arkusz1.A6 odpada, a makra mi nie kopiują po filtrze, a poza tym w ogóle nie znam sie na makrach. Bardzo proszę o pomoc

[belstar]

Dodatki:
http://extensions.openoffice.org/en/pro ... n-4213-094
http://extensions.libreoffice.org/exten ... ible-cells

[Dawidxyz]

Niestety nie mogę odpalić linka, mógłbym ponownie prosić o pomoc?

[belstar]

https://www.google.pl/#q=open+office+co ... ible+cells

[Dawidxyz]

Mam makro, wygląda jakby kopiowało ale skąd i dokąd? Da się to jakoś ustawić, żeby te widoczne dane kopiowało do x komórek?(Widoczne dane są zawsze tylko w jednym wierszu, i jest on pod wierszem 5, bo to autofiltr) Wtedy w drugim arkuszu który ma być pełnym zleceniem zrobiłbym tylko odwołania do komórek do których są kopiowane wartości wg filtru.

Makro:

Kod: Zaznacz cały

Public strMsg(10) as string

Sub CopyOnlyVisibleCells
  On Error goto MultipleSelections
  
  Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
  Dim arrayProp(0) As New com.sun.star.beans.PropertyValue
  arrayProp(0).Name = "Hidden"
  arrayProp(0).Value = true
  
  Dim arrayPropPaste(5) as new com.sun.star.beans.PropertyValue
  arrayPropPaste(0).Name = "Flags"
  arrayPropPaste(0).Value = "SVDNT"
  arrayPropPaste(1).Name = "FormulaCommand"
  arrayPropPaste(1).Value = 0
  arrayPropPaste(2).Name = "SkipEmptyCells"
  arrayPropPaste(2).Value = false
  arrayPropPaste(3).Name = "Transpose"
  arrayPropPaste(3).Value = false
  arrayPropPaste(4).Name = "AsLink"
  arrayPropPaste(4).Value = false
  arrayPropPaste(5).Name = "MoveMode"
  arrayPropPaste(5).Value = 4
  
  initStrLocale  
  firstDoc = ThisComponent
  oExt = firstDoc.getCurrentSelection()
  oEnd = oExt.getRangeAddress()
  firstSheet = firstDoc.Sheets.getByIndex(oEnd.Sheet)
  selectSheetByIndex(firstDoc, oEnd.Sheet)
  dispatchURL(firstDoc,".uno:SelectAll")
  dispatchURL(firstDoc,".uno:Copy")
  secondDoc = StarDesktop.loadComponentFromUrl("private:factory/scalc","_blank",0,arrayProp())
  secondDoc.getSheets().insertNewByName("inserted",0)
  selectSheetByName(secondDoc, "inserted")
  dispatchURL(secondDoc,".uno:InsertContents",arrayPropPaste())
  secondSheet = secondDoc.Sheets.getByName("inserted")
  intHiddenCols = 0
  intHiddenRows = 0  
  
  intCountTargetCol = oEnd.StartColumn
  intCountTargetRow = oEnd.StartRow
  
  For C = oEnd.StartColumn to oEnd.EndColumn
      If not firstSheet.Columns(C).isVisible then 
         secondSheet.Columns.removeByIndex(intCountTargetCol, 1)
         intHiddenCols = intHiddenCols + 1
      else
         intCountTargetCol = intCountTargetCol + 1   
      Endif 
  Next C 
  For R = oEnd.StartRow to oEnd.EndRow     
      If not firstSheet.Rows(R).isVisible then
         secondSheet.Rows.removeByIndex(intCountTargetRow, 1)
         intHiddenRows = intHiddenRows + 1
      else
         intCountTargetRow = intCountTargetRow + 1
      Endif  
   Next R     
   CellRangeAddress.Sheet = oEnd.Sheet
   CellRangeAddress.StartColumn = oEnd.StartColumn
   CellRangeAddress.StartRow = oEnd.StartRow
   CellRangeAddress.EndColumn = oEnd.EndColumn - intHiddenCols
   CellRangeAddress.EndRow = oEnd.EndRow - intHiddenRows   
   CopyRangeToClipboard(secondDoc, CellRangeAddress)  
   secondDoc.dispose()
   SelectRange(firstDoc,oEnd)
   Exit Sub
 MultipleSelections:
   MsgBox strMsg(0),64, strMsg(1)
End Sub


Sub selectSheetByName(document, sheetName)
   document.getCurrentController.select(document.getSheets().getByIndex(sheetName))
End Sub

Sub selectSheetByIndex(document, sheetIndex)
   document.getCurrentController.select(document.getSheets().getByIndex(sheetIndex))
End Sub

Sub dispatchURL(document, aURL, optional oProps() as com.sun.star.beans.PropertyValue)

  Dim noProps()
  Dim URL As New com.sun.star.util.URL
  frame = document.getCurrentController().getFrame()
  URL.Complete = aURL
  transf = createUnoService("com.sun.star.util.URLTransformer")
  transf.parseStrict(URL)
  disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
  if isError(oProps()) then
      disp.dispatch(URL, noProps())
  else
      disp.dispatch(URL, oProps())
  endif     
End Sub


'Author: Ryan Nelson
'email: ryan@aurelius-mfg.com
'Modified by: Christian Junker
'Modified by: Gustavo Pacheco, 2010
'
Sub CopyRangeToClipboard(oSourceDoc as Object, oSourceRange as com.sun.star.table.CellRangeAddress)
   Dim oTargetDoc As Object, oTargetSheet As Object, oTargetCell As Object
   Dim oDisp, octl as Object
   Dim sUrl As String
   Dim NoArg()
   REM Set source doc/currentController/frame/sheet/range.
   octl = oSourceDoc.getCurrentController()
   oSourceframe = octl.getFrame()
   oSourceSheet= oSourceDoc.Sheets(0)
   oSourceRange2 = oSourceSheet.getCellRangeByPosition(oSourceRange.StartColumn,oSourceRange.StartRow,oSourceRange.EndColumn, oSourceRange.EndRow)
   REM create the DispatcherService
   oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
   REM select source range
   octl.Select(oSourceRange2)
   REM copy the current selection to the clipboard.
   oDisp.executeDispatch(octl, ".uno:Copy", "", 0, NoArg())
End Sub

Sub SelectRange (oSourceDoc as Object, oSourceRange as com.sun.star.table.CellRangeAddress)
   Dim oDisp, octl as Object
   Dim sUrl As String
   REM Set source doc/currentController/frame/sheet/range.
   octl = oSourceDoc.getCurrentController()
   oSourceframe = octl.getFrame()
   oSourceSheet= oSourceDoc.Sheets(oSourceRange.Sheet)
   oSourceRange2 = oSourceSheet.getCellRangeByPosition(oSourceRange.StartColumn,oSourceRange.StartRow,oSourceRange.EndColumn, oSourceRange.EndRow)
   REM create the DispatcherService
   oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
   REM select source range
   octl.Select(oSourceRange2)
End Sub



Sub initStrLocale as String
   Dim PathSubstitutionService As Object
   PathSubstitutionService = createUnoService("com.sun.star.util.PathSubstitution")
   OOLangue = PathSubstitutionService.getSubstituteVariableValue("$(langid)")
   Select Case OOLangue
     Case "1046" ' Brazilian Portuguese
        strMsg(0) = "Esta função não pode ser utilizada com seleções múltiplas."
        strMsg(1) = "BrOffice.org"
     Case "1033" ' English USA
        strMsg(0) = "This function cannot be used with multiple selections."
        strMsg(1) = "OpenOffice.org"
     Case "2057" ' English GB
        strMsg(0) = "This function cannot be used with multiple selections."
        strMsg(1) = "OpenOffice.org"
     Case "1036" ' French
        strMsg(0) = "Cette fonction est incompatible avec la sélection multiple."
        strMsg(1) = "OpenOffice.org"
     Case "1034","3082" ' Spanish
        strMsg(0) = "Esta función no se puede aplicar con selecciones múltiples."
        strMsg(1) = "OpenOffice.org"
   End Select
End Sub

'http://msdn.microsoft.com/en-us/goglobal/bb964664.aspx

[Dawidxyz]

A może dałoby się wstawić jakąś tabelę która stałaby pod filtrem i z niej zasysać dane? Tabela wielkości 2 wierszy i drugi wiersz zmienny zalezy co tam wyfiltruje do niego, hmm?

[Astur]

Niestety nie mogę odpalić linka, mógłbym ponownie prosić o pomoc?

Kopiowanie tylko widocznych komórek. Rozszerzenie to stanowi alternatywę dla polecenia 'select' widocznych komórek w programie Microsoft Excel. Jest przydatne przy korzystaniu z sum częściowych lub zakresów z ukrytych kolumn i wierszy. Uwaga! Nie jest możliwe używanie tego rozszerzenia z opcją Wklej specjalnie...

• Dla LibreOffice: http://extensions.libreoffice.org/exten ... ible-cells
  Dla OpenOffice: http://extensions.openoffice.org/en/projectrelease/091

[belstar]

Mam makro, wygląda jakby kopiowało ale skąd i dokąd?

To makro to jest ten dodatek, czyli skopiowałeś zawartość biblioteki po instalacji dodatku.
Analiza kodu krok po kroku pomogła by ci zrozumieć zasadę działania i na podstawie tego stworzyć satysfakcjonujące rozwiązanie. Jeśli jednak nie czujesz się na siłach zrobić to sam, postaram się ci pomóc.

No to zaczynamy czy sam próbujesz?