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
关注公众号『长空雪』
搬孕工 分享孕妇写真 关注我微信公众号 长空雪 “情而不色”是我公众号的风格