Makro til at gemme fane

Brugerhjælp og support til makroer i LibreOffice Basic

Moderators: Lodahl, LarsBrandi

Post Reply
COOL_M_F
Posts: 1
Joined: Fri Aug 31, 2012 8:11

Makro til at gemme fane

Post by COOL_M_F » Fri Aug 31, 2012 9:17

Hvad jeg har:
Har lavet et regneark hvor jeg hælder en masse data ind i den første fane.
Der er lavet en knap der aktiverer en makro.
Makroen behandler data på første fane og opretter nye faner med de behandlede data.

Hvad jeg mangler:
Makroen skal kunne gemme de enkelte faner i hver sit regneark

Lige nu gør jeg det at jeg højreklikker på de enkelte faner og vælger flyt/kopier og vælger at flytte fanen til nyt dokument.
Derefter gemmer jeg det nye dokument.

Da jeg havner et sted mellem 50 og 100 faner og skal til at generere dem en del gange om året savner jeg en makro der kan gemme de enkelte faner for mig.

Er der nogen der kan hjælpe mig på rette spor

Jens S
Posts: 1091
Joined: Sun Mar 25, 2007 21:42

Post by Jens S » Sat Sep 01, 2012 14:34

Hvis du absolut skal bruge makroer, kan du passende begynde her http://wiki.openoffice.org/wiki/Documen ... readsheets
Formulerer du din søgning i Google rigtig, finder du også de rigtige kodestumper.

mvh
Jens

User avatar
Lodahl
Posts: 1957
Joined: Wed Sep 14, 2005 7:27
Location: Storkøbenhavn
Contact:

Post by Lodahl » Sat Sep 01, 2012 16:21

hej,
Ønsker du at den skal kopiere alle faner til hvert sit ark, eller er det manuelt en fane ad gangen?
Med venlig hilsen

Leif Lodahl
Blog: https://libreofficedk.blogspot.dk
LibreOffice: http://da.libreoffice.org

User avatar
Lodahl
Posts: 1957
Joined: Wed Sep 14, 2005 7:27
Location: Storkøbenhavn
Contact:

Post by Lodahl » Sat Sep 01, 2012 22:03

Code: Select all

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

Sub Main
	oDoc = thisComponent
	oFileName = oDoc.Location
	SplitSheets( oFileName )
End Sub

Sub SplitSheets( cCalcDocToSplit ) 
   oDoc = thisComponent
   nNumSheets = oDoc.getSheets().getCount()   
   nHighestSheetNumber = nNumSheets-1
   For nSheetToSave = 0 To nHighestSheetNumber
      oDoc = StarDesktop.loadComponentFromURL( ConvertToURL( cCalcDocToSplit ), "_blank", 0, Array() )
      DeleteAllSheetsExcept( oDoc, nSheetToSave )
      cNewName = thisComponent.sheets(nSheetToSave).Name
      oDoc.storeToURL( ConvertToURL( DocumentFilePath & getPathSeparator & cNewName & ".ods" ), _
         Array() )     
      oDoc.close( True )
   Next
   
End Sub

Function DeleteAllSheetsExcept( oDoc, nSheetToKeep )
   nNumSheets = oDoc.getSheets().getCount()
   nHighestSheetNumber = nNumSheets-1
   nSheetToDelete = nHighestSheetNumber
   Do while nSheetToDelete > nSheetToKeep
      oSheet = oDoc.getSheets().getByIndex( nSheetToDelete )
      oDoc.getSheets().removeByName( oSheet.getName() )
      nSheetToDelete = nSheetToDelete - 1
   Loop
   
   For i = 0 To nSheetToKeep - 1
      ' Delete the first Sheet.
      nSheetToDelete = 0
      ' Get the Sheet.
      oSheet = oDoc.getSheets().getByIndex( nSheetToDelete )
      ' Tell the document to remove it.
      oDoc.getSheets().removeByName( oSheet.getName() )
   Next
End Function


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 

Function DocumentFilePath
  Dim oDoc
  Dim sDocURL
  oDoc = ThisComponent
  If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
    GlobalScope.BasicLibraries.LoadLibrary("Tools")
  End If
  If (oDoc.hasLocation()) Then
    sDocURL = oDoc.getURL()
   DocumentFilePath = DirectoryNameoutofPath(sDocURL, "/")
   
  End If
End Function
Med venlig hilsen

Leif Lodahl
Blog: https://libreofficedk.blogspot.dk
LibreOffice: http://da.libreoffice.org

Post Reply

Who is online

Users browsing this forum: No registered users and 2 guests