libreoffice表格根据名称批量插入图片_libreoffice吧

libreoffice吧关注：626贴子：929

6回复贴，共1页

libreoffice表格根据名称批量插入图片

公司不让用EXCEL.用的这个鬼libreoffice.很简单的功能到这边就变复杂了，由于需求批量往表格里插入图片，故做了一翻研究，通过宏代码目前亲测可行，特提供代码跟大家分享，送给有需要的朋友，喜欢的帮顶！谢谢！
以下为插入至单元格图片的代码，图片大小是根据单元格大小定的！有需要插入批注里图片的，可以M我，我可以提供
Sub insert_pic()
Dim s$,x1%, x2%,i%, j%, y1%, y2%
Dim Sheet As Object
s = ""
Dim t$
t = ""
Dim Size As New com.sun.star.awt.Size
Dim FilePicker As Object
FilePicker=createUnoService("com.sun.star.ui.dialogs.FolderPicker")
FilePicker.execute
path_str = FilePicker.getDirectory()
Set oCell = ThisComponent.getCurrentSelection
Set aCellAddress = oCell.getRangeAddress
y1 = aCellAddress.StartColumn
x1 = aCellAddress.StartRow
y2 = aCellAddress.EndColumn
x2 = aCellAddress.EndRow
SheetIndex = aCellAddress.Sheet
Sheet = ThisComponent.Sheets.getByIndex(SheetIndex)
opage = Sheet.drawpage
For j = y1 to y2
For i = x1 to x2
Range1 = sheet.getCellByPosition(j, i)
t = Range1.String
t= converttourl(path_str & "/" & t & ".jpg")
size.Height = sheet.Rows(i).Height
size.width = sheet.Columns(j+(y2-y1)).Width
oshape = thiscomponent.createInstance("com.sun.star.drawing.GraphicObjectShape")
with oshape
.name = "Shape1"
.size = size
.position = sheet.getCellByPosition(j+(y2-y1), i).Position
.GraphicURL = t
end with
opage.add(oshape)
Next
Next End
End Sub

送TA礼物

IP属地:美国

来自iPhone客户端1楼2016-01-12 17:21回复

IP属地:河南

来自Android客户端2楼2016-01-15 16:55

虽然看不懂

IP属地:河南

来自Android客户端3楼2016-01-15 16:55

IP属地:福建

4楼2016-05-21 04:41

升级版

REM ***** BASIC *****
Sub insert_pic()
Dim s As String, x1%,x2%,i%,j%,y1%,y2%
Dim sheet As Object
s=""
Dim t As String
t=""
Dim Size As New com.sun.star.awt.Size
path_str = "D:\pic\"
Set oCell = ThisComponent.getCurrentSelection
Set aCelladdress = oCell.getRangeAddress
y1 = aCelladdress.StartColumn
x1 = aCelladdress.StartRow
y2 = aCelladdress.EndColumn
x2 = aCelladdress.EndRow
SheetIndex = aCelladdress.Sheet
Sheet = ThisComponent.Sheets.getByIndex(SheetIndex)
opage = Sheet.drawpage
For j = y1 to y2
For i = x1 to x2
Range1 = sheet.getCellByPosition(j,i)
t = Range1.String
t = converttourl(path_str & "/"& t & ".jpg")
m = Dir(t)
if m="" then
t=""
End if
size.Height = sheet.Rows(i).Height
size.width = sheet.Columns(j).Width
oshape = thiscomponent.createInstance("com.sun.star.drawing.GraphicObjectShape")
with oshape
.size = size
.position = sheet.getCellByPosition(j,i).Position
.GraphicURL = t
.LineStyle = com.sun.star.drawing.LineStyle.SOLID
.LineWidth = 30
.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
.FillBitmapURL = Dir(t)
.FillBitmaPMode = com.sun.star.drawing.BitmapMode.STRETCH
end with
opage.add(oshape)
Next
call SuoDing
Next end
End Sub
sub SuoDing
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:SelectObject", "", 0, Array())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:ToggleAnchorType", "", 0, Array())
end sub

IP属地:美国

来自iPhone客户端5楼2016-05-29 09:48