LibreOffice-Forum

Code: Alles auswählen

Sub Export()
Dim Sheet As Object


Sheet = ThisComponent.Sheets.getByName("xxx")
ThisComponent.CurrentController.setActiveSheet(Sheet)

dim document   as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
Dim args1(2) as new com.sun.star.beans.PropertyValue
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
args1(0).Name = "DocName"
args1(0).Value = ""
args1(1).Name = "Index"
args1(1).Value = 1
args1(2).Name = "Copy"
args1(2).Value = true
dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())

' CopyPaste(Sheet , oSheet_Ziel , "A1:AA100", "A1:AA100")
End Sub

Code: Alles auswählen

Sub CopyPaste(oSheet_Quelle As Object, oSheet_Ziel As Object, Range_Quelle As String, Range_Ziel As String)
	Dim DatArray
	DatArray = oSheet_Quelle.getCellRangeByName(Range_Quelle).getDataArray
	oSheet_Ziel.getCellRangeByName(Range_Ziel).setDataArray(DatArray) 	
End Sub

Code: Alles auswählen

Sub Main
  Dim sNewURL$    'URL For a NEW calc document "private:factory/scalc"
  Dim oNewDoc     'New Document
  Dim oFrame      'Frame that can perform the dispatch
  Dim oDispatcher 'The dispatcher to use
  Dim oSheet      'The current active sheet
  Dim i%          'General Index Variable
  Dim iActive%    'Currently active sheet
  REM This will copy FROM ThisComponent
  oFrame = ThisComponent.CurrentController.Frame
  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  oSheet = ThisComponent.CurrentController.getActiveSheet()
  iActive = -1 : i = 0
  Do While iActive < 0
    If ThisComponent.Sheets(i).Name = oSheet.Name Then
      iActive = i
    Else
      i = i + 1
    End If
  Loop

  sNewURL = "private:factory/scalc"
  oNewDoc = StarDesktop.loadComponentFromURL(sNewURL, "_blank", 0, Array())

  Dim args(2) as new com.sun.star.beans.PropertyValue
  args(0).Name  = "DocName"               
  args(0).Value = "Untitled1"   'This copies to the document named Untitled1
  args(1).Name  = "Index"
  args(1).Value = iActive
  args(2).Name  = "Copy"
  args(2).Value = True          'Set to Flase to perform a Move
     
  oDispatcher.executeDispatch(oFrame, ".uno:Move", "", 0, args())
End Sub

Code: Alles auswählen

CopyByName

Code: Alles auswählen

importsheet

Code: Alles auswählen

Sub Export()
'
' Export Makro
' Ausschließlicher Export des Blattes "xxx"
'

'
    Sheets("Klassifizierung").Select    ' Auswahl des Tabellenblatts mit Namen "xxx"
    Cells.Select                        ' alle Zellen des Blatts auswählen
    Selection.Copy                      ' alle Zellen kopieren
    Workbooks.Add                       ' neue Datei erstellen und hinzufügen
                                        ' Blattinhalte und -formatierungen einfügen
                                        
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Tabelle1").Select           'Tabellenblatt umbenennen
    Sheets("Tabelle1").Name = "Export"
    Range("B1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Close savechanges:=True
    
End Sub