“模仿是创造的第一步,也是学习的最初形式。”
第一份工作是在市调行业,参与过其中的满意度调查。 这个满意度调查内容涵盖城市 管理的四大方面——市容环境、秩序环境、生态环境和设施环境,通俗来讲就是人们生活中的吃喝住行。 满意度调查中,有这样一个环节,访问人员会将受访者提供的现场问题拍摄成照片打包发送给研究人员,然后研究人员会将问题整合在excel表里。频率是一周一次,每次大概6-12个问题,耗时20分钟。 为了增加20分钟上班摸鱼时间,我从网上查资料、看问答,凑出了一个VBA。 本着给自己总结的心态,剖析一下这个凑编 的VBA。01
—
第一步:凑
基本思路框架: 1. 能够读取到所在位置的文件夹名称; 2. 能够将文件夹底下的所有图片插入到excel表里。 于是上网查找有没有现成的VBA,关于VBA网上学习查找关键字: excel VBA + 预实现功能 ,根据这个关键字段搜索,一般都能找到你需要的功能,即使没有现成的也有参考的。02
—
第二步:编
实现的第一个功能: 读取文件名Sub 读取文件夹名字和图片()' 读取文件夹名字和图片 MacroSheets("Sheet2").Range("A1:M20").DeleteDim Excel对象 As Excel.Application, 当前路径Dim str1, Str2当前路径 = ThisWorkbook.pathDim fs, ps As Objectn = 1Set fs = CreateObject("Scripting.FileSystemObject")Set f = fs.getfolder(当前路径)For Each fd In f.subfoldersSheets("Sheet1").Cells(n + 2, 2) = fd.NameSheets("Sheet2").Cells(n, 1) = fd.NameSheets("Sheet1").Cells(n + 2, 1) = nSheets("Sheet1").Rows(n + 2 & ":" & n + 2).RowHeight = 114'到这一步是读取文件名字n = n + 1NextSheets("Sheet2").Range("M1") = n - 1 + 2Set f = NothingSet fs = NothingEnd Sub
第二个功能:
将文件夹底下的所有图片插入到excel表里
最小白的思路,也许有更多简便的方法,但是对于目前的我来说,这个方法更容易使VBA小白的我好理解。
插入文件夹底下图片,根据第一个功能,已经可以通过遍历,分别进入到各个文件夹内,但由于网上的插入图片教程大部分是有规律的图片命名,不适用于我工作所需。于是,下一个搜素思路就是读取图片具体名字,提高程序的普适性。
Sub 添加名称()'获取指定路径下的图片名称(※不带后缀)Dim path As String当前路径 = ThisWorkbook.pathDim fs, ps As ObjectFor n = 1 To 8Set fs = CreateObject("Scripting.FileSystemObject")Set f = fs.getfolder(当前路径 & "/" & Sheets("Sheet2").Range("A" & n) & "/")Set fso = CreateObject("scripting.filesystemobject")path = 当前路径 & "/" & Sheets("Sheet2").Range("A" & n) & "/"i = 2Filename = Dir(path & "/*.jpg")Do While Filename <> ""Sheets("Sheet2").Cells(n, i) = fso.getbasename(Filename)Filename = Diri = i + 1LoopNext n'插入图片Dim j As IntegerFor j = 1 To 20Sheets("Sheet2").Range("L" & j).SelectSelection.Formula = "=IF(COUNTA(B" & j & ":K" & j & ")=0," & """" & "" & """" & ",COUNTA(B" & j & ":K" & j & "))+1"Next jDim a, b As IntegerDim str1 As StringDim pic As VariantFor a = 3 To Sheets("Sheet2").Range("M1") For b = 2 To Sheets("Sheet2").Range("L" & a - 2) Sheets("Sheet1").Activate Sheets("Sheet1").Range("C" & a).Select str1 = 当前路径 & "\" & Sheets("Sheet2").Range("A" & a - 2) & "\" & Sheets("Sheet2").Cells(a - 2, b) & ".jpg" 'Set pic = Nothing Set pic = ActiveSheet.Pictures.Insert(str1) pic.Placement = xlMoveAndSize With pic.ShapeRange .LockAspectRatio = msoFalse .Height = 113.385826 .Width = 113.385826 .Left = Sheets("Sheet1").Range("C" & a).Left + 114 * (b - 2) End With Next bNext aEnd Sub
有两个核心的“技术”:
1. 直白地在新建一个sheet2将读取的文件夹名称和图片名称现实地放在数据表里;
2. 根据数量进行遍历,然后插入图片。
明显不足:由于n只到8,j只到20,也就是说如果不在程序上改n的上限和j的上限,就只会给你读取20个文件夹,每个文件夹不超过10张图片,当文件夹或文件夹图片过多明显需要修改上限。