Ask Your Question
0

Copy Spreadsheet Macro

asked 2016-11-11 18:05:54 +0200

greatone15 gravatar image

updated 2016-11-11 19:02:19 +0200

Lupp gravatar image

Hello I have had code to copy an existing spreadsheet into a brand new one for years and all of a sudden it stopped working. I can't seem to find anything on the web that states what change might of happened. I am hoping someone here would be able to shed some light on it.

Here is the code that I have for copying a spreadsheet.

Sub copyCurrentSheet

mFile =  Month(Date)

Select Case mFile

    Case 1
    fileDate1 = "Jan "

    Case 2
    fileDate1 = "Feb "

    Case 3
    fileDate1 = "Mar "

    Case 4
    fileDate1 = "Apr "

    Case 5
    fileDate1 = "May "

    Case 6
    fileDate1 = "Jun "

    Case 7
    fileDate1 = "Jul "

    Case 8
    fileDate1 = "Aug "

    Case 9
    fileDate1 = "Sep "

    Case 10
    fileDate1 = "Oct "

    Case 11
    fileDate1 = "Nov "

    Case 12
    fileDate1 = "Dec "

End Select

fileDate2 = fileDate1 & Day(Date) & ","  & Year(Date)
fileDate1 = fileDate2

doc1 = ThisComponent
oSheets = doc1.getSheets() 

y = "1"   
fileNameExists = "yyyyy"


Do While fileNameExists <> "xxxxx"

    If oSheets.hasByName(fileDate1) Then
        y = y + 1 
        fileDate1 = fileDate2 & " " & y
    Else 
        fileNameExists = "xxxxx"

    End If


Loop


doc1 = ThisComponent
oSheet1 = StarDesktop.CurrentComponent.CurrentController.ActiveSheet


oSheet2 = oSheet1
currentSheet = oSheet1.getName()


selectSheetByName(doc1, currentSheet)
dispatchURL(doc1,".uno:SelectAll")
dispatchURL(doc1,".uno:Copy")
doc1.getSheets().insertNewByName(fileDate1, 0)
selectSheetByName(doc1, fileDate1)
dispatchURL(doc1,".uno:Paste")


oSheet1 = StarDesktop.CurrentComponent.CurrentController.ActiveSheet
printerOption(0).Name = "PaperOrientation"
printerOption(0).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
thisComponent.Printer = printerOption()

oSheet1.setPrintareas (oSheet2.getPrintareas())


doc1 = ThisComponent
oController = doc1.getCurrentController   ' freezes active sheet
oController.freezeAtPosition(11,2) 


oCell=oSheet1.getCellRangeByName("F1")
oCell.setValue(DateValue(Now))
oCell.NumberFormat=75

oCell = oSheet1.getCellRangeByName("C4")

ThisComponent.CurrentController.select(oCell) 

Thiscomponent.getSheets().getByName(oSheet1.getName()).Protect("")

End Sub

(Edited for better readability by @Lupp)

edit retag flag offensive close merge delete

Comments

How did you call the Sub?
What did happen telling you that the Sub had stopped working?

Unsolicited advice: Do not split yearly data collections into sheets/documents per month. This is Paper-Do, not how spreadsheets should be used. Many questions discussed on different forums show (IMO) that the splitting is a persistent source of trouble. So does my own experience.

Where spreadsheets are too inefficient to keep an undivided collection of all the data, use a database.

Lupp gravatar imageLupp ( 2016-11-11 19:10:33 +0200 )edit

I call the sub by pushing a button that I created on the sheet. I wrote this basic years ago and oddly it just recently stopped working. By stopped working when I do my copy sheet sub it would do all of the motions of creating the new sheet with the file name and what not but it didn't bring over any of the existing data. I am not sure what you mean by splitting yearly data collections into sheets. The spreadsheet just contains my bills that I pay every two weeks.

greatone15 gravatar imagegreatone15 ( 2016-11-11 22:10:23 +0200 )edit

1 Answer

Sort by » oldest newest most voted
0

answered 2016-11-11 20:34:29 +0200

mark_t gravatar image

updated 2016-11-11 20:38:29 +0200

Edit: Suspect the use of dispatchURL but that might have been a sub that you did not post.

Updated version below, also tried to simplify the code a little. Hopefully it works as intended.

Option Explicit

Sub copyCurrentSheet

    Dim oController As Variant
    Dim oDocument As Variant
    Dim oDispatcher As Variant
    Dim doc1 As Variant
    Dim fileDate1 As String
    Dim fileDate2 As String
    Dim oSheet1 As Variant
    Dim oSheet2 As Variant
    Dim oSheets As Variant
    Dim oCell As Variant
    Dim y As Integer
    Dim fileNameExists As Boolean
    Dim printerOption(0) AS NEW com.sun.star.beans.PropertyValue

    fileDate2 = format(Date, "MMM D, YYYY")
    fileDate1 = fileDate2

    doc1 = ThisComponent 
    oSheet2 = doc1.CurrentController.ActiveSheet

    oSheets = doc1.getSheets()

    y = 0
    fileNameExists = True

    Do While fileNameExists
        If oSheets.hasByName(fileDate1) Then
            y = y + 1 
            fileDate1 = fileDate2 & " " & y
        Else 
            fileNameExists = False
        End If
    Loop

    oController = doc1.getCurrentController
    oDocument   = oController.Frame
    oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    oDispatcher.executeDispatch(oDocument, ".uno:SelectAll", "", 0, array())
    oDispatcher.executeDispatch(oDocument, ".uno:Copy", "", 0, array())

    doc1.getSheets().insertNewByName(fileDate1, 0) 

    oSheet1 = doc1.getSheets().getByIndex(0)
    oController.setActiveSheet(oSheet1)

    oDispatcher.executeDispatch(oDocument, ".uno:Paste", "", 0, array())

    printerOption(0).Name = "PaperOrientation" 
    printerOption(0).Value = com.sun.star.view.PaperOrientation.LANDSCAPE 
    doc1.Printer = printerOption()

    oSheet1.Printareas = oSheet2.Printareas

    ' freezes active sheet '
    oController.freezeAtPosition(11,2)

    oCell = oSheet1.getCellRangeByName("F1") 
    oCell.Value = DateValue(Now)
    oCell.NumberFormat = 75

    oController.select(oSheet1.getCellRangeByName("C4"))

    oSheet1.Protect("")
End Sub
edit flag offensive delete link more

Comments

Thank you so much for this. I have no idea what happened that broke what I had before but this code works perfectly and looks like it is quicker then what I had before too.

greatone15 gravatar imagegreatone15 ( 2016-11-11 22:14:38 +0200 )edit
Login/Signup to Answer

Question Tools

1 follower

Stats

Asked: 2016-11-11 18:05:54 +0200

Seen: 466 times

Last updated: Nov 11 '16