分享传递知识

Libreoffice macro 将工作表复制到另外一个电子表格

Libreoffice macro 将工作表复制到另外一个电子表格

Sub CopySpreadsheet_all
    Dim doc1,doc2 as object
    Dim sheetName as string
    Dim FileName as String
    Dim URLStr,DirName as String
    Dim sheetYear, sheetMonth as String
    Dim tempName as String
   
   
sheetYear = ThisComponent.Sheets(0).getCellByPosition(0,0).getString()
    sheetMonth = ThisComponent.Sheets(0).getCellByPosition(2,0).getString()
    sheetName = “xinji”    
    doc1 = ThisComponent

    If (Year(now) <> Int(sheetYear) or Month(now) <> Int(sheetMonth)) Then //判断电子表格中日期与当前日期是否相同
        for i=0 to 2
            sheetName =    doc1.Sheets(i).getName()
            selectSheetByName_all(doc1, sheetName)
            docName_all(doc1,FileName,DirName)
            tempName = left(FileName,4) & sheetName
             dispatchURL(doc1,”.uno:SelectAll”)
            dispatchURL(doc1,”.uno:Copy”)
            doc2 = StarDesktop.loadComponentFromUrl(“private:factory/scalc” , “_blank”,0,dimArray())
            doc2.getSheets().insertNewByName(sheetName,0)
            selectSheetByName_all(doc2, sheetName)
            dispatchURL(doc2,”.uno:Paste”)
            While 1 < doc2.Sheets.Count  //始终移除第二个工作表
                doc2.Sheets.removeByname(doc2.Sheets(1).getName())
            WEnd       
            SaveAs_all(tempName,DirName)
        next
            ClearDefinedRange_all(doc1)
            Save_all(doc1,DirName)
  End If

End Sub

Sub selectSheetByName_all(oDoc, sheetName)
    oDoc.getCurrentController.select(oDoc.getSheets().getByName(sheetName))
End Sub

Sub dispatchURL_all(oDoc, aURL)
    Dim noProps()
    Dim URL As New com.sun.star.util.URL
    Dim frame
    Dim transf
    Dim disp
    frame = oDoc.getCurrentController().getFrame()
    URL.Complete = aURL
    transf = createUnoService(“com.sun.star.util.URLTransformer”)
    transf.parseStrict(URL)
    disp = frame.queryDispatch(URL, “”,com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
    disp.dispatch(URL, noProps())
End Sub

长空雪


关注公众号『长空雪』

搬孕工 分享孕妇写真 关注我微信公众号 长空雪 “情而不色”是我公众号的风格

赞(0) 打赏

觉得文章有用就打赏一下文章作者

非常感谢你的打赏,我们将继续给力更多优质内容,让我们一起创建更加美好的网络世界!

支付宝扫一扫打赏

微信扫一扫打赏