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
, ML, MT, MW, MH).Select
_
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\"
"x" + ".jpg"
End Sub
*** cells (8, 4) 的值是图片的名称
我的vba code 有错...
"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
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
Next w1
If Not ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation, HEADER
Exit Sub
End If
