Excel 批量插入图片 VBA代码.doc

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 NextApplication.ScreenUpdating = False 关闭屏幕更新Dim MR As RangeFor Each MR In SelectionIf Not IsEmpty(MR) And Dir(ActiveWorkbook.Path & & MR.Value & .jpg) ThenMR.SelectML = MR.LeftMT = MR.TopMW = MR.WidthMH = MR.HeightActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).SelectSelection.ShapeRange.Fill.UserPicture _ActiveWorkbook.Path & & MR.Value & .jpg 当前文件所在目录下以当前单元内容为名称的.jpg图片End IfNextSet MR = NothingApplication.ScreenUpdating = True 开启屏幕更新End Sub我想 按一下按钮，插入图片 我的 vba code 如下: Sub Picture_Click_06202010()x = Cells (8, 4).ValueChDir C:UsersmynameDesktoppictureActiveSheet.Pictures.Insert x + .jpgEnd Sub* cells (8, 4) 的 值是图片的名称 我的 vba code 有错. ActiveSheet.Pictures.Insert(C:UsersmynameDesktoppicture & x & .jpg)插入档案时请用全路径，不要用 ChDir 变更工作路径，因为 ChDir 无法处理变更工作磁盘。Excel,遗忘密码后如何撤销工作表保护密码1、打开您需要撤销保护密码的Excel文件；2、依次点击菜单栏上的工具-宏-录制新宏，输入宏名字如:ab；3、停止录制(这样得到一个空宏)；4、依次点击菜单栏上的工具-宏-宏,选ab,点编辑按钮；5、删除窗口中的所有字符(只有几个),替换为以下内容；Public Sub 工作表保护密码()Const DBLSPACE As String = vbNewLine & vbNewLineConst AUTHORS As String = DBLSPACE & vbNewLine & _作者:ericConst HEADER As String = 工作表保护密码Const VERSION As String = DBLSPACE & 版本 Version 1.1.1Const REPBACK As String = DBLSPACE & Const ZHENGLI As String = DBLSPACE & ericConst ALLCLEAR As String = DBLSPACE & 该工作簿中的工作表密码保护已全部解除。 & DBLSPACE & 请记得重新设置密码 _& DBLSPACE & 注意：此方法仅用于遗忘密码使用。Const MSGNOPWORDS1 As String = 该文件工作表中没有加密Const MSGNOPWORDS2 As String = 该文件工作表中没有加密2Const MSGTAKETIME As String = 请耐心等候! & DBLSPACE & 按确定开始回复Const MSGPWORDFOUND1 As String = 密码重新组合为: & DBLSPACE & $ & DBLSPACE & _如果该文件工作表有不同密码,将搜索下一组密码并修改清除Const MSGPWORDFOUND2 As String = 密码重新组合为: & DBLSPACE & $ & DBLSPACE & _如果该文件工作表有不同密码,将搜索下一组密码并解除Const MSGONLYONE As String = 确保为唯一的?Dim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenElseOn Error Resume NextDo dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126With ActiveWorkbook.Unprotect Chr(i) & Chr(j) & Chr(k) & _Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)If .ProtectStructure = False And _.ProtectWindows = False ThenPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)MsgBox Application.Substitute(MSGPWORDFOUND1, _$, PWord1), vbInformation, HEADERExit Do Bypass all for.nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In WorksheetsAttempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In WorksheetsChecks for all clear ShTag triggered to 1 if not.ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126.Unprotect Chr(i) & Chr(j) & Chr(k) & _Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)If Not .ProtectContents ThenPWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)MsgBox Application.Substitute(MSGPWORDFOUND2, _$, PWord1), vbInformation, HEADERleverage finding Pword by trying on other sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do Bypass all for.nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADEREnd Sub6、关闭编辑窗口；7、依次点击菜单栏上的工具-宏-宏,选AllInternalPasswords,运行,确定两次，等候一两分钟,会出现以下对话框： 这是Excel密码对应的原始密码(此密码和之前设置的密码均能打开此文档。Powerpoint VBA快速插入多张图片当微软的Office与微软VB中的宏功能相遇时，便可以创造出强大的功能，例如在这篇文章中就介绍了利用这两个工具瞬间插入上百张图片。 如果要插入几十甚至几百张图片，并且要求每张图片插入到每张幻灯片页面上(即有几张照片就要有几张幻灯片)你会怎么做? 按照常用的方法点击“插入图片来自文件”菜单命令，然后一个一个选择需要的图片，或者点击“格式背景”命令，将图片作为PowerPoint的背景导入，这样也太浪费时间了。在这种情况下，可以借助PowerPoint强大的宏功能，将多步操作合并为一步，批量插入图片。 第一步：首先准备好图片，假设在C盘下面的Pictures文件夹内有100张jpg格式的图片，如“C：Pictures1.jpg”、“C：Pictures2.jpg”、“C：Pictures3.jpg”等，文件名是有序的数字 第二步：启动PowerPoint 2003，按下Alt+F11键打开Visual Basic编辑器窗口，点击“插入模块”菜单命令，在弹出的代码编辑窗口中输入以下代码： Sub InsertPic() Dim i As Integer For i = 1 To ActivePresentation.Slides.Count ActivePresentation.Slides(i).Select With ActiveWindow.Selection.SlideRange .FollowMasterBackground = msoFalse .Background.Fill.UserPicture C：Pictures & i & .jpg End With Next End Sub 第三步：关闭Visual Basic编辑器窗口，上面的模块代码会自动保存。此时，连续按Ctrl+M键建立与图片数目相等(如：100)的多个空白幻灯片。按Alt+F8键打开宏对话框，选中我们上面建立的InsertPic宏，点击“运行”即可，100张图片很快就自动插入到幻灯片中电子表格如何通过VBA批量导入相片? 如何将某个文件夹里的1.jpg至100.jpg相片分别批量导入到Sheet1工作表中的G1至G100，而且根据单元格的大小自动调整相片的大小，vba怎样完成？ 2011-4-23 01:15 最佳答案 单元格大小是否固定？除非每张相片的尺寸一致，否则不好调整。程序如下 ：Sub test()定义一个文件对话框以获取文件Dim fd As FileDialog定义获取文件名的字符串Dim fn As String设置为文件拾取器Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd定义按钮名称和对话框标题，并设置为允许多重选择以达到批量完成的效果 .ButtonName = 浏览 .Ti