Einzelne Tabelle ohne Buttons speichern

[Mephisto]

Wieder mal muss ich mich nach langer Suche an euch wenden
Eigentlich sollte es eine sehr simple Aufgabe sein, aber ich finde mal wieder nichts dazu.

Folgendes Problem:

Ich habe mehrere Tabellen innerhalb eines Calc-Dokuments.
Ich möchte Tabelle 1 ohne die enthaltenen Buttons abspeichern. Das "alte" Dokument soll natürlich unangetastet bleiben.
(Ob das Dokument im CurDir gespeichert wird, oder ein Dialog dafür aufpoppt ist mir erstmal egal)

Kann mir da bitte jemand weiterhelfen?

[komma4]

Ich möchte Tabelle 1 ohne die enthaltenen Buttons abspeichern. Das "alte" Dokument soll natürlich unangetastet bleiben.

Rechtsklick auf den Tabellenreiter>Tabelle verschieben/kopieren>Ins Dokument: -neues Dokument- und Häkchen bei Kopieren. Dann dort die Schaltflächen entfernen.

[Mephisto]

Vielen Dank für deine schnelle Antwort, aber da hab ich mich nicht deutlich genug ausgedrückt. Sry.

Zusammenklicken ist kein Problem. Ich will aber, dass es automatisiert über ein Makro passiert.
D.h. Button anklicken und fertig ist mein Dokument.

[Mephisto]

Ich habe mal versucht, mit dem makro recorder zu arbeiten, auch wenn der mich bisher nie weitergebracht hat.

folgendes ist dabei rausgekommen:

Code: Alles auswählen

sub record
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "DocName"
args1(0).Value = ""
args1(1).Name = "Index"
args1(1).Value = 32767
args1(2).Name = "Copy"
args1(2).Value = true

dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())

Wenn ich diesen Code ausführe habe ich ein neues Dokument offen, das das gewünschte Sheet enthält.
Doch wie schaffe ich es jetzt auf dieses Dokument zuzugreifen?

Wenn ich einfach 'thisComponent' verwende, wird auf das "alte" Sheet zugegriffen. Befehle in die Richtung:

Code: Alles auswählen

newDocument = dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())
newDocument.DoSomething

oder

Code: Alles auswählen

document.DoSomething '  "document" wurde als Parameter übergeben

sind gescheitert.
Wenn ich auf das Dokument zugreifen könnte, hätte ich wenigstens eine Basis auf der ich arbeiten kann (Buttons entfernen, abspeichern usw.)
Aber bis ich das rausgefunden habe sitze ich auf dem trockenen...

[Mephisto]

Nach langer, langer Suche. Stunden mit google verbracht und einem Code von hier habe ich es nun endlich geschafft.

Ich speichere zuerst eine kopie meine Dokuments, lösche dann alle überflüssigen Sheets, und löschen schließlich alle Objecte(=Buttons) aus dem verbliebenen sheet.

Umständlich, aber es funktioniert.

hier der code, falls jemand dasselbe Problem hat:

Code: Alles auswählen

REM  *****  BASIC  *****

REM  *****  BASIC  *****
'Copyright (c) 2011 Frieder Delor, Mailto: Einfach hier im Forum anschreiben :-)
'The funktion: GetPath()is originally from :Copyright (c) 2011 Volker Lenhardt
'This program is free software; you can redistribute it and/or modify it under 
'the terms of the GNU General Public License as published by the Free Software
'Foundation; either version 2 of the License, or (at your option) any later 
'version.

'This program is distributed in the hope that it will be useful, but WITHOUT 
'ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
'FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

'You should have received a copy of the GNU General Public License along with 
'this program; if not, write to the Free Software Foundation, Inc., 59 Temple 
'Place, Suite 330, Boston, MA 02111-1307 USA
'=======================================================
Sub Main
	ExportToODS ("Cockpit")
end sub

Sub ExportToODS (sTableNam As String)
  sPath = GetPath
  If sPath = "" Then
    MsgBox "Invalid directory", 16, "ERROR"
    goTo Zeile1
  End If 
  Zeile0:
  sStandard = "MyCockpit_" & Format(Now,"dd.mm.yyyy") 
  sName=InputBox ("Please enter a name" & Chr(10) & _
                  "for the file" , "ODS Name", sStandard )
  If sName="" Then
    nVar=MsgBox ("You didn't enter a name. " & Chr(10) & _
                 "Please specify the name. " & Chr(10) & _
                 "If you click on 'CANCEL' " & Chr(10) & _
                 "the export will be aborted.", 1, "ERROR")
    If nVar=1 then 'OK clicked
      goTo Zeile0
    Else
      goTo Zeile1
    End if  
  End if
  
  sFileName= sName & ".ods"
  
  If FileExists(sPath & sFileName) then
  	nVar=MsgBox ("The file exists already. " & Chr(10) & _
                 "Do you want to replace the document? " & Chr(10) & _
                 Chr(10) & _
                 "'CANCEL' = abort export " & Chr(10) & _
                 "'NO' = reenter name" & Chr(10) _
                 , 3, "Fehler")
    Select Case nVar
	    Case 2 'Cancel clicked
	      goTo Zeile1
	    Case 6 'Yes clicked
	    Case 7 'No clicked
	      goTo Zeile0
    End Select 
  end if
  ThisComponent.addActionLock
  ThisComponent.LockControllers
  oDoc = ThisComponent
  oSheets = oDoc.Sheets
  oSheet1 =oDoc.Sheets.getByName(sTableNam) 
  Delete_PrintAreas
	For n = 0 To oSheets.getCount - 1
	  oSheet=oDoc.Sheets(n)
	  if oSheet.Name= sTableNam Then 
	  lEndCol= GetLastUsedColumn(oSheet1)
	  lEndRow=GetLastUsedRow(oSheet1)
	    Set_PrintAreas (n ,0 ,0 ,lEndCol ,lEndRow)
	  End if
	Next
  export_cockpit(sPath & sFileName) 
  Delete_PrintAreas
  adjustDocument (sPath & sFileName)
  MsgBox "Cockpit successfully exported at" & CHR$(10) & ConvertFromUrl(sPath & sFileName) , 0, "Success"

  Zeile1:
	  ThisComponent.UnlockControllers 
	  ThisComponent.removeActionLock
End sub
'-------------------------------------------
sub Delete_PrintAreas 'Alle Druckbereich Löschen
  oDoc = ThisComponent
  oSheet = oDoc.Sheets(0)
  for n =0 to oDoc.Sheets.getCount - 1
    oDoc.Sheets(n).setPrintAreas(Array ())
  Next
end sub
'----------------------------------------
Sub Set_PrintAreas (nSheet As Integer,lStartCol As Long,_
lStartRow As Long,lEndCol As Long,lEndRow As Long) 'Drukbereich festlegen
  Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
  oDoc = ThisComponent
  oSheet = oDoc.Sheets(nSheet)
  CellRangeAddress.Sheet = nSheet
  CellRangeAddress.StartColumn = lStartCol
  CellRangeAddress.StartRow = lStartRow
  CellRangeAddress.EndColumn = lEndCol
  CellRangeAddress.EndRow = lEndRow
  aPrintAreas()=Array (CellRangeAddress)
  oSheet.setPrintAreas(aPrintAreas())

End sub
'------------------------------------
Function GetLastUsedRow(oSheet as Object) As Integer 
  Dim oCell
  Dim oCursor
  Dim aAddress
  
  oCell = oSheet.getCellByPosition(0, 0)
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.gotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedRow = aAddress.EndRow
End Function

' Returns the number of the last column 
'of a continuous data range in a sheet.
Function GetLastUsedColumn(oSheet as Object) As Long
  Dim oCell
  Dim oCursor
  Dim aAddress

  oCell = oSheet.getCellByPosition(0, 0)
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.gotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedColumn = aAddress.EndColumn
End Function
'----------------------------------
Function GetPath() As String
  Dim  oPathSettings, oFolderDialog
  Dim sPath As String

    oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
    sPath = oPathSettings.Work
    oFolderDialog = _
          CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
    oFolderDialog.SetDisplayDirectory(sPath)
    If oFolderDialog.Execute() = _
          com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
      sPath = oFolderDialog.GetDirectory
    Else
      GetPath = ""
      Exit Function
    End If
  If Right(sPath, 1) <> "/" Then sPath = sPath & "/"
  GetPath = sPath
End Function 
'------------------------------------
sub export_cockpit (sFileName AS String)

  dim args1(1) as new com.sun.star.beans.PropertyValue

  args1(0).Name = "ExportFormFields" 'just show the contents of the Form.Fields
  args1(0).Value= True
  args1(1).Name = "Printing" ' you don't need that.
  args1(1).Value= 0

  dim args2(2) as new com.sun.star.beans.PropertyValue

  args2(0).Name = "FilterName"
  args2(0).Value = ""
  args2(1).Name = "FilterData"
  args2(1).Value = args1
  args2(2).Name = "SelectionOnly" 'Only the selected printarea will get exported
  args2(2).Value = true

  ThisComponent.storeToURL(sFileName,args2())
end sub


Sub adjustDocument (documentPath as String)
	Dim oDocument
	Dim myFileProp(0) as New com.sun.star.beans.PropertyValue
	
    myFileProp(0).name= "Hidden"
    myFileProp(0).value= True 
    
	oDocument = StarDesktop.loadComponentFromURL(documentPath, "_blank", 0, myFileProp() )
	
	oDocument.Sheets(0).unprotect( Functions.getPassword() )
	
	'Input sheet isn't needed
	oDocument.Sheets.removeByName("Input")
	' Remove Buttons
	Call deleteObjects(oDocument)
	
		' This field is marked es not protected (for further information have a look @ Function.protectSheet
		DIM  budgetProtection		
		budgetProtection = oDocument.Sheets(0).getCellRangeByName("B4").CellProtection
		budgetProtection.isLocked = TRUE
		oDocument.Sheets(0).getCellRangeByName("B4").CellProtection = budgetProtection
		
	oDocument.Sheets(0).protect( Functions.getPassword() )
	'Save changes
	oDocument.store()
	'Close document
	oDocument.close(false)
end sub

Sub deleteObjects(oDocument as Object)
	Dim nextInputRow as Integer
	Dim CellRange
	
	nextInputRow = 21 ' Row, where the opps will appear in the cockpit sheet. All Buttons are above of this area

	' Normally the input in the cockpitsheet should start @ row 21
	IF(oDocument.Sheets(0).getCellRangeByName("A" & nextInputRow - 1).String <> "RM Flag") THEN
		' If the keyword "RM Flag" is not @ "A21" --> search for it
		nextInputRow = 0
		DO
			nextInputRow = nextInputRow + 1
		LOOP UNTIL oDocument.Sheets(0).getCellRangeByName("A" & nextInputRow).String = "RM Flag"
		nextInputRow = nextInputRow + 1 ' Jump to the next free row
	END IF
	
	CellRange = oDocument.Sheets(0).getCellRangeByName("A1:N" & nextInputRow)

	Flags = com.sun.star.sheet.CellFlags.OBJECTS ' remove (only) Objects (Buttons are Objects)

	CellRange.clearContents(Flags)
END SUB

*viel Spaß beim scrollen

PS: der einzige Schönheitsfehler ist jetzt noch, dass das exportierte Sheet alle Makros enthält --> ich werde beim öffnen gefragt, ob ich makros erlauben will. Kann man das irgendwie umgehen, indem man alle Makros aus dem dokument löscht?

[DPunch]

Aloha

Was für Inhalte sollen denn kopiert werden?
Wenn es um schlichte Daten geht, kannst Du mit .getDataArray und .setDataArray vermutlich einiges an Umwegen sparen.
(Neue Datei erstellen, DataArray rüberkopieren, speichern, schliessen).
Alternativ gibt es noch die Alternative des kurzfristigen Setzen eines SheetLinks, dadurch sollten die Steuerelemente ebenfalls nicht mitgenommen werden.
Der Code sieht auf jeden Fall arg lang aus für ein solches Anliegen.

[Mephisto]

Für ein Array werden es wohl zu viele Daten sein.
Das mit den Sheetlinks klingt aber vielversprechend. Hast du da vll. ein Codeschnipsel parat?

Edit @alfredo: Deine Version hat einwandfrei funktioniert.

der Befehl

Code: Alles auswählen

oDocument.BasicLibraries.removeLibrary( "Standard" )

erbrachte das gewünschte Ergebnis

[DPunch]

Aloha

Für ein Array werden es wohl zu viele Daten sein.

Ich weiss nicht, wie Du zu dieser Annahme kommst, aber das wage ich zu bezweifeln

Das mit den Sheetlinks klingt aber vielversprechend. Hast du da vll. ein Codeschnipsel parat?

Code: Alles auswählen

	sSourceSheetName = "Tabelle1"
	sTargetURL = "C:\CopyOf_" & sSourceSheetName & "_ " & DAY(NOW) & "_" & MONTH(NOW) & "_" & YEAR(NOW) & ".ods"	
	oDoc = thisComponent
	sSourceURL = oDoc.URL
	Dim args(0) as new com.sun.star.beans.PropertyValue
	args(0).Name = "Hidden"
	args(0).Value = True
	oNewDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args)
	oTargetSheet = oNewDoc.Sheets.getByIndex(0)
	oTargetSheet.LinkMode = 1
	oTargetSheet.LinkURL = ConvertToURL(sSourceURL)
	oTargetSheet.LinkSheetName = sSourceSheetName
	oTargetSheet.LinkMode = 0	
	oNewDoc.storeAsURL(ConvertToURL(sTargetURL),Array())
	oNewDoc.close(True)
	MsgBox "Abgeschlossen"