excel vba自动图片导入

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了excel vba自动图片导入相关的知识,希望对你有一定的参考价值。

想问下大家下面问题如何实现。我建了一个图片文件夹,里面放了很多图片,图片大小是一样的。我想把这些图片导入到excel单元格里面,是放入单元格区域,保证单元格大小与图片大小一致,表面看起来,就像这张图片嵌入在单元格里面。由于图片较多,人工较麻烦,各位有没有啥好的方法。另外图片的导入,是根据单元格条件语句的判定来决定是否导入。
Worksheets(Sheet110).Active
Select Case xiabiao '根据下标,确定的单元格位置,插入相应的图片
Case 0
Cells(i + 3, 2).selcet
ActiveSheet.Cells(i + 3, 2).Pictures.Insert("C:\Users\honjoy\Pictures\破损图片库\image12.png").Select
Case 1
Cells(i + 3, 2).selcet
ActiveSheet.Cells(i + 3, 2).Pictures.Insert("C:\Users\honjoy\Pictures\破损图片库\image11.png").Select
Case 2
Cells(i + 3, 2).selcet
ActiveSheet.Cells(i + 3, 2).Pictures.Insert("C:\Users\honjoy\Pictures\破损图片库\image23.png").Select
........
.........
.....
为什么运行到select case 后说类型不匹配?

假设图片放在D盘根目录名为test的文件夹中,则可使用下列VBA代码自动插入图片:
Sub Insertpic()
Shell ("cmd /c dir ""D:\test"" /a:-d /b >""D:\2888.txt")
Application.Wait (Now + TimeValue("0:00:01"))

Sheet2.Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\2888.txt", _
Destination:=Range("$A$1"))
.Name = "1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
d = Sheet2.Range("A10000").End(xlUp).Row

a = Sheet2.Cells(1, 1)
Sheet3.Select
ActiveSheet.Pictures.Insert ("D:\test\" & a)
b = ActiveSheet.Shapes(1).Width
c = ActiveSheet.Shapes(1).Height

m = Sheet1.Range("A1").Width / Sheet1.Columns(1).ColumnWidth
n = b / m
Sheet1.Columns("A:A").ColumnWidth = n
m = Sheet1.Range("A1").Width / Sheet1.Columns(1).ColumnWidth
n = b / m
Sheet1.Columns("A:A").ColumnWidth = n
m = Sheet1.Range("A1").Width / Sheet1.Columns(1).ColumnWidth
n = b / m
Sheet1.Columns("A:Z").ColumnWidth = n
Sheet1.Rows("1:10000").RowHeight = c

e = Int(960 / b)

For i = 1 To d
f = Int(i / e) + 1
If f = Int((i - 1) / e) + 2 Then
f = f - 1
End If
g = i Mod e
If g = 0 Then
g = e
End If
a = Sheet2.Cells(i, 1)
Sheet1.Shapes.AddPicture _
"D:\test\" & a, _
True, True, (g - 1) * b, (f - 1) * c, b, c
Next i

Sheet1.Select
End Sub
说明:1.上述代码可自动识别图片名称及图片尺寸,自动识别图片数量等;
2.必须以管理员账户登录电脑,才能成功执行上述代码;
3.需要放到"thisworkbook"的VBA编辑框才能运行;
4.执行该代码会在D盘根目录中生成一个名为2888的txt格式文件,运行完成后,可删除该文件;
5.每张图片尺寸不能超过320*546像素,若超过,则不能成功执行代码,可将图片文件夹的图片按名称排序后,将第一张图片的尺寸改小到上述尺寸以内,再执行代码;
6.图片数量超过10000张时,上述代码需要做适当修改。
参考技术A 可以用vba完成.
假设图片名称在A列,图片放在当前文件所在文件夹下的\pic\目录,且格式均为jpg.
运行下面的代码可以根据A列名称将相应的图片插入到对应行的b列位置,且调整大小恰好与其所在单元格一致.

按住alt,依次按f11,i,m
粘贴代码后按f5

Sub test()
p = ThisWorkbook.Path & "\pic\"
For r = 2 To Range("a65536").End(xlUp).Row
With Cells(r, 2)
ActiveSheet.Shapes.AddPicture(p & Cells(r, 1) & ".jpg", 0, 1, .Left, .Top, .Width, .Height).Placement = xlMoveAndSize
End With
Next
End Sub
参考技术B 假设图片有100张,图片格式为“.jpg",图片放在”D:\PICTURE“中,要放入图片的名称写在A1到A100中(不含后缀名),图片插入到B1到B100的单元格。代码如下:

Sub 插入图片()
Dim I As Integer
For I = 1 To 100
Cells(I, 2).Select
ActiveSheet.Pictures.Insert "D:\PICTURE\" & Cells(I, 1) & ".jpg"
Next I
End Sub追问

按照你的方法试了下,说对象不支持该属性和方法。请问如何解决?

追答

select 关键字拼写错误,你写成了selcet

select 关键字拼写错误,你写成了selcet

本回答被提问者采纳
参考技术C 很简单!

求大神帮写VBA,以及导入方法,有函数的单元格内容自动转换为纯文本。

需要把图片内的绿色区域的函数结果转换到黄色区域并变为纯文本,如:21-11-01 星期一,需要转换范围F2:AJ2转换文本至F3:AJ3,顺便教一下宏的录制导入,谢谢!!!

参考技术A Sub 文本()
arr = Range("f2:aj2")
[f3].Resize(1, 31) = arr
End Sub追问

请问一下怎么导入,感谢!

追答

右键 sheet名,查看代码,复制进去
运行这个代码

追问

这位老师不好意思,代入这个代码以后,出现的文本是日期文本,我想要这种:21-11-01 星期一,这种文本,因为需要带函数公式进行查找数据。感谢!~

追答

把你公式发来看下

追问

=COUNTIFS(INDIRECT("每日统计!$A$5:$A$2329"),'考勤(日)'!$D4,INDIRECT("每日统计!$G$5:$G$2329"),'考勤(日)'!F$3,INDIRECT("每日统计!$H$5:$H$2329"),"*白*")

把页面显示的文本样式直接转换成实际文本,就想复制后,手动选择数值黏贴一样的效果。图片内的粉色数字5,是在我手动输入F3的文本以后,公式生效

追答

试下这个

就是变为把公式结果变为 纯数值
Sub 选择粘贴为数值()
Range("F2:aj2").Select
Selection.Copy
Range("F3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub

本回答被提问者采纳

以上是关于excel vba自动图片导入的主要内容,如果未能解决你的问题,请参考以下文章

利用VBA如何将批量图片导入WORD的指定表格格式里?

求大神帮写VBA,以及导入方法,有函数的单元格内容自动转换为纯文本。

通过 VBA 将 XML 导入 EXCEL 不会刷新

将 Excel 文件导入 Access VBA 时更改数据类型

为啥sql数据库的表用VBA导到EXCEL中的速度比EXCEL的数据导入功能慢

关于Visio的vba操作,遍历目录,对所有vsd文件操作,导入excel文件