Makro kopiujące arkusz

[DariaArek]

Witam

Na tym forum znalazłem makro, które kopiuje wybrany arkusz do nowego pliku.
W arkuszu mam pare guzików, formuł itd.
W jaki sposób można zmienić makro aby kopiowało mi arkusz ale bez tych wszystkich przycisków itd ?
Chodzi mi o to aby skopiować to tak jak wygląda dokument na podglądzie czyli tak jak się drukuje.

Kod: Zaznacz cały

' Katalog bazowy dokumentów
Const csBaseDocDir As String = "c:\Dowody"
Const csSheetName As String = "Faktura"
Const csNumberFormat As String = "000000"

Private sPathSep As String

' ========================================================
' SaveSheet
' ========================================================
Sub SaveSheet
 Dim oDoc As Object
 Dim oSheet As Object
 Dim oCell As Object
 Dim dDate As Date
 Dim sDocNumber As String
 
 Dim sDateISO As String
 Dim sDirDay As String
 Dim sDirMonth As String
 Dim sDirYear As String
 Dim sDir As String

 sPathSep = GetPathSeparator()
 
 oDoc = ThisComponent
 oSheet = oDoc.Sheets.getByName(csSheetName)

 oCell = oSheet.getCellByPosition(10,1) ' B3 Data dok.
 dDate =  oCell.getValue()
 
 oCell = oSheet.getCellByPosition(15,2) ' F8 Numer dok.
  sDocNumber = oCell.getString()  ' wartosc jako tekst
' sDocNumber = Format(oCell.getValue(), csNumberFormat) ' wartosc z formatowaniem
   
 sDateISO = CDateToISO(dDate)
 sDirDay = Right(sDateISO,2)
 sDirMonth = Mid(sDateISO, 5, 2)
 sDirYear = Left(sDateISO, 4)
 sDir = csBaseDocDir + sPathSep + sDirYear  +  _
                      sPathSep + sDirMonth 
 SaveDocument sDir,  sDocNumber + ".ods"
 
End Sub

' ========================================================
' SaveDocument
' ========================================================
Sub SaveDocument( sDirName As String, sFileName As String )

 
  Dim args(0) As New com.sun.star.beans.PropertyValue
  Dim sURL As String
  
  MkDir(sDirName)
  
  sURL=ConvertToURL(sDirName + sPathSep + sFileName)
  ThisComponent.storeToURL(sURL, args())
End Sub

Pozdrawiam

[belstar]

Witam

Rozwiązanie pierwsze:
Zrób sobie swój pasek narzędzi i usuń wszystkie przyciski z arkusza.

Rozwiązanie drugie:
Wykorzysta poniższe makro i dopiero z niego wywołaj swoje. Makro to kopiuje zakres komórek „oSourceRange” z arkusza o nazwie „A” do zakresu komórek „oDestRange” w arkuszu o nazwie „B”. Kopiowane są tylko wartości bez formuł. Wstaw sobie pomocniczy arkusz (tutaj arkusz „B”) i teraz przerób swoje makro żeby to ten arkusz kopiowało.

Kod: Zaznacz cały

sub Kopiuj_Zakres
	oDoc = ThisComponent
	oSheet = oDoc.Sheets.getByName("A")
	oSourceRange = oSheet.getCellRangeByName("A1:C26")'zmień zaakres
	oDataArray = oSourceRange.getDataArray
   
	oDestSheet = oDoc.Sheets.getByName("B")
	oDestRange = oDestSheet.getCellRangeByName("A1:c26")'zmień zakres
	oDestRange.setDataArray(oDataArray)
	'uauwanie zawartości zakresu
	'tu wstaw wywolanie swojej procedury
	With com.sun.star.sheet.CellFlags
  		flagi = .STRING + .VALUE + .DATETIME + .FORMULA
	End With 
	oDestRange.clearContents(flagi)
end sub

Pozdrawiam

[DariaArek]

Dziękuję za odpowiedz.
Mam jeszcze pytanie.
Czy jest proste makro, które powodowało by zapisanie kopii tak jak ręcznie eksportujemy dokument do PDF ?

[belstar]

Proszę bardzo

Kod: Zaznacz cały

Sub CopyPDF
   oDoc = Thiscomponent 'the document running the macro
   oSheet = oDoc.getCurrentController().getActiveSheet() ' the active sheet
   'oDoc.g1etCurrentController.Select oSheet
  'print osheet.name()
   cFile = ("/home/Twój_katalog/"& oSheet.name()&".pdf")'Windows c:\COŚ_TAM
   cUrl = ConvertToUrl( cFile )
   oDoc.storeToUrl( cUrl, Array( MakePropertyValue( "FilterName", "calc_pdf_Export", "Selection,0,0")))
End Sub

Function MakePropertyValue( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
   oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" )
   If Not IsMissing( cName ) Then
      oPropertyValue.Name = cName
   EndIf
   If Not IsMissing( uValue ) Then
      oPropertyValue.Value = uValue
   EndIf
   MakePropertyValue() = oPropertyValue
End Function

Pozdrawiam