Excel 批量插入图片 VBA代码

Excel 批量插入图片VBA代码(2011-06-24 08:56:26)转载标签：excel批量插入图片代码杂谈

在要插入图片的文件夹里新建一个Excel文件，打开这个Excel文件，在要插入图片的单元格里填上图片文件名（不要扩展名），选中要插入图片的单元格，修改单元格的大小以显示所需要的图片大小，运行宏代码。

1、Alt+F11调取VBA编辑窗口，查看代码，将以下代码全部复制进去；

2、关闭VBA窗口，Excel-视图-宏-查看宏；

3、Book1.xls!Sheet1.insertPic，选中所要插入图片的单元格，执行；

4、图片自动插入对应的单元格中。（图片尺寸均可通过单元格大小进行调解，边框可设置）

代码如下：

Sub insertPic()

' 宏由 万加美酒编写，时间: 2009-6-1

' Dir函数批量获取指定目录下所有文件名和内容

On Error Resume Next

Application.ScreenUpdating = False '关闭屏幕更新

Dim MR As Range

For Each MR In Selection

If Not IsEmpty(MR) And Dir(ActiveWorkbook.Path & "\" & MR.Value & ".jpg") <> "" Then MR.Select

ML = MR.Left

MT = MR.Top

MW = MR.Width

MH = MR.Height

ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select

erPicture _

ActiveWorkbook.Path & "\" & MR.Value & ".jpg" '当前文件所在目录下以当前单元内容为名称的.jpg图片

End If

Next

Set MR = Nothing

Application.ScreenUpdating = True '开启屏幕更新

End Sub

我想"按一下按钮，插入图片"

我的vba code 如下:

Sub Picture_Click_06202010()

x = Cells (8, 4).Value

ChDir "C:\Users\myname\Desktop\picture\"

ActiveSheet.Pictures.Insert "x" + ".jpg"

End Sub

*** cells (8, 4) 的值是图片的名称

我的vba code 有错...

ActiveSheet.Pictures.Insert("C:\Users\myname\Desktop\picture\" & x & ".jpg")

插入档案时请用全路径，不要用ChDir 变更工作路径，因为ChDir 无法处理变更工作磁盘。

Excel,遗忘密码后如何撤销工作表保护密码

1、打开您需要撤销保护密码的Excel文件；

2、依次点击菜单栏上的工具---宏----录制新宏，输入宏名字如:ab；

3、停止录制(这样得到一个空宏)；

4、依次点击菜单栏上的工具---宏----宏,选ab,点编辑按钮；

5、删除窗口中的所有字符(只有几个),替换为以下内容；

Public Sub 工作表保护密码()

Const DBLSPACE As String = vbNewLine & vbNewLine

Const AUTHORS As String = DBLSPACE & vbNewLine & _

"作者:eric"

Const HEADER As String = "工作表保护密码"

Const VERSION As String = DBLSPACE & "版本Version 1.1.1"

Const REPBACK As String = DBLSPACE & ""

Const ZHENGLI As String = DBLSPACE & " eric"

Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除。" & DBLSPACE & "请记得重新设置密码" _

& DBLSPACE & "注意：此方法仅用于遗忘密码使用。"

Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"

Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"

Const MSGTAKETIME As String = "请耐心等候!" & DBLSPACE & "按确定开始回复"

Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _

"如果该文件工作表有不同密码,将搜索下一组密码并修改清除"

Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _

"如果该文件工作表有不同密码,将搜索下一组密码并解除"

Const MSGONL YONE As String = "确保为唯一的?"

Dim w1 As Worksheet, w2 As Worksheet

Dim i As Integer, j As Integer, k As Integer, l As Integer

Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer

Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer

Dim PWord1 As String

Dim ShTag As Boolean, WinTag As Boolean

Application.ScreenUpdating = False

With ActiveWorkbook

WinTag = .ProtectStructure Or .ProtectWindows