vbaword表格插入图片.docx
《vbaword表格插入图片.docx》由会员分享，可在线阅读，更多相关《vbaword表格插入图片.docx（6页珍藏版）》请在冰豆网上搜索。
vbaword表格插入图片
竭诚为您提供优质文档/双击可除
vba,word表格插入图片
篇一：
Vba统一处理woRd中的图片大小
subadjustpicwidthandheight（）
alte
adjustpicwidthandheight宏
dimn,m
dimblnisinlineshapeasboolean
dimmylineshapeasinlineshape
onerrorResumenext忽略错误
Foreachmylineshapeinactivedocument.inlineshapes
ifmylineshape.height>mylineshape.widththen
selection.inlineshapes.converttoshape
selection.shapeRange.incrementRotation90
endif
next
Forn=1toactivedocument.inlineshapes.countinlineshapes类型的图片
h=activedocument.inlineshapes（n）.height
w=activedocument.inlineshapes（n）.width
activedocument.inlineshapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比ifh>wthen
blnisinlineshape=ture
selection.inlineshapes（n）.converttoshape
selection.shapeRange.incrementRotation-90
endif
nextn
m=activedocument.inlineshapes.count
Forn=1to2inlineshapes类型的图片
activedocument.inlineshapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比
activedocument.inlineshapes（n）.height=153设置图片高度为243px
activedocument.inlineshapes（n）.width=243设置图片高度为153px
activedocument.inlineshapes（n）.Range.paragraphs
（1）.Range.paragraphFormat.characterunitFirstlineindent=0
activedocument.inlineshapes（n）.Range.paragraphs
（1）.Range.paragraphFormat.Firstlineindent=0
activedocument.inlineshapes（n）.Range.paragraphs
（1）.Range.paragraphFormat.alignment=wdalignparagraphcenter
nextn
Forn=1to2inlineshapes类型的图片
activedocument.shapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.shapes（n）.height=153设置图片高度为153px
activedocument.shapes（n）.width=243设置图片高度为243px
nextn
Forn=3tominlineshapes类型的图片
activedocument.inlineshapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.inlineshapes（n）.height=297设置图片高度为297px
activedocument.inlineshapes（n）.width=405设置图片高度为405px
nextn
Forn=3tominlineshapes类型的图片
activedocument.shapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.shapes（n）.height=297设置图片高度为297px
activedocument.shapes（n）.width=405设置图片高度为405px
nextn
withselection.paragraphFormat
.leftindent=centimeterstopoints（0）
.Rightindent=centimeterstopoints（0）
.spacebefore=50
.spacebeforeauto=False
.spaceafter=50
.spaceafterauto=False
.linespacingRule=wdlinespacemultiple
.linespacing=linestopoints（3）
.alignment=wdalignparagraphcenter
.widowcontrol=False
.keepwithnext=False
.keeptogether=False
.pagebreakbefore=False
.nolinenumber=False
.hyphenation=true
.Firstlineindent=centimeterstopoints（0）
.outlinelevel=wdoutlinelevelbodytext
.characterunitleftindent=0
.characterunitRightindent=0
.characterunitFirstlineindent=0
.lineunitbefore=10
.lineunitafter=10
.mirrorindents=False
.textboxtightwrap=wdtightnone
.autoadjustRightindent=true
.disablelineheightgrid=False
.Fareastlinebreakcontrol=true
.wordwrap=true
.hangingpunctuation=true
.halfwidthpunctuationontopofline=False
.addspacebetweenFareastandalpha=true
.addspacebetweenFareastanddigit=true
.baselinealignment=wdbaselinealignauto
endwith
endsub
sub处理扫描照片（）
处理扫描照片宏
dimn,m
dimblnisinlineshapeasboolean
dimmylineshapeasinlineshape
onerrorResumenext忽略错误
m=activedocument.inlineshapes.count
Forn=1to2inlineshapes类型的图片
activedocument.inlineshapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.inlineshapes（n）.height=153设置图片高度为243px
activedocument.inlineshapes（n）.width=243设置图片高度为153px
nextn
Forn=1to2inlineshapes类型的图片
activedocument.shapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.shapes（n）.height=153设置图片高度为153px
activedocument.shapes（n）.width=243设置图片高度为243px
nextn
Forn=3tominlineshapes类型的图片
activedocument.inlineshapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.inlineshapes（n）.height=297设置图片高度为297px
activedocument.inlineshapes（n）.width=405设置图片高度为405px
nextn
Forn=3tominlineshapes类型的图片
activedocument.shapes（n）.lockaspectRatio=msoFalse不锁定图片的纵横比activedocument.shapes（n）.height=297设置图片高度为297px
activedocument.shapes（n）.width=405设置图片高度为405px
nextn
withselection.paragraphFormat
.leftindent=centimeterstopoints（0）
.Rightindent=centimeterstopoints（0）.spacebefore=50
.spacebeforeauto=False
.spaceafter=50
.spaceafterauto=False
.linespacingRule=wdlinespacemultiple.linespacing=linestopoints（3）
.alignment=wdalignparagraphcenter.widowcontrol=False
.keepwithnext=False
.keeptogether=False
.pagebreakbefore=False
.nolinenumber=False
.hyphenation=true
.Firstlineindent=centimeterstopoints（0）.outlinelevel=wdoutlinelevelbodytext.characterunitleftindent=0
.characterunitRightindent=0
.characterunitFirstlineindent=0.lineunitbefore=10
.lineunitafter=10
.mirrorindents=False
.textboxtightwrap=wdtightnone.autoadjustRightindent=true
.disablelineheightgrid=False
.Fareastlinebreakcontrol=true.wordwrap=true
.hangingpunctuation=true
.halfwidthpunctuationontopofline=False.addspacebetweenFareastandalpha=true.addspacebetweenFareastanddigit=true.baselinealignment=wdbaselinealignautoendwith
endsub
篇二：
excel批量插入图片Vba代码
excel批量插入图片Vba代码（20xx-06-2408:
56:
26）转载标签：
excel批量插入图片代码杂谈
在要插入图片的文件夹里新建一个excel文件，打开这个excel文件，在要插入图片的单元格里填上图片文件名（不要扩展名），选中要插入图片的单元格，修改单元格的大小以显示所需要的图片大小，运行宏代码。
1、alt+F11调取Vba编辑窗口，查看代码，将以下代码全部复制进去；
2、关闭Vba窗口，excel-视图-宏-查看宏；
3、book1.xls!
sheet1.insertpic，选中所要插入图片的单元格，执行；
4、图片自动插入对应的单元格中。
（图片尺寸均可通过单元格大小进行调解，边框可设置）
代码如下：
subinsertpic（）
宏由万加美酒编写，时间:
20xx-6-1
dir函数批量获取指定目录下所有文件名和内容
onerrorResumenext
application.screenupdating=False关闭屏幕更新
dimmRasRange
ForeachmRinselection
ifnotisempty（mR）anddir（activeworkbook.path当前文件所在目录下以当前单元内容为名称的.jpg图片
endif
next
setmR=nothing
application.screenupdating=true开启屏幕更新
endsub
我想"按一下按钮，插入图片"
我的vbacode如下:
subpicture_click_062020xx（）
x=cells（8,4）.Value
chdir"c:
\users\myname\desktop\picture\"
activesheet.pictures.insert"x"+".jpg"
endsub
***cells（8,4）的值是图片的名称
我的vbacode有错...
activesheet.pictures.insert（"c:
\users\myname\desktop\picture\"
dummydoloop
Fori=65to66:
Forj=65to66:
Fork=65to66
Forl=65to66:
Form=65to66:
Fori1=65to66
Fori2=65to66:
Fori3=65to66:
Fori4=65to66
Fori5=65to66:
Fori6=65to66:
Forn=32to126
withactiveworkbook
.unprotectchr（i）bypassallfor...nexts
endif
endwith
next:
next:
next:
next:
next:
next
next:
next:
next:
next:
next:
next
loopuntiltrue
onerrorgoto0
endif
ifwintagandnotshtagthen
msgboxmsgonlyone,vbinformation,headeR
exitsub
endif
onerrorResumenext
Foreachw1inworksheets
attemptclearancewithpword1
w1.unprotectpword1
nextw1
onerrorgoto0
shtag=False
Foreachw1inworksheets
checksforallclearshtagtriggeredto1ifnot.
shtag=shtagorw1.protectcontents
nextw1
ifshtagthen
Foreachw1inworksheets
withw1
if.protectcontentsthen
onerrorResumenext
dodummydoloop
Fori=65to66:
Forj=65to66:
Fork=65to66
Forl=65to66:
Form=65to66:
Fori1=65to66
Fori2=65to66:
Fori3=65to66:
Fori4=65to66
Fori5=65to66:
Fori6=65to66:
Forn=32to126
.unprotectchr（i）leveragefindingpwordbytryingonothersheets
Foreachw2inworksheets
w2.unprotectpword1
nextw2
exitdobypassallfor...nexts
endif
next:
next:
next:
next:
next:
next
next:
next:
next:
next:
next:
next
loopuntiltrue
onerrorgoto0
endif
endwith
nextw1
endif
msgboxallcleaR定义一个文件对话框以获取文件
dimfdasFiledialog
定义获取文件名的字符串
dimfnasstring
篇三：
用Vba复制图片到word中
用Vba复制图片到word中
dimobjwordappasword.application
dimobjwordasword.document
Range（cells（3,2）,cells（11,11））.select
selection.copypicture
setobjwordapp=createobject（"word.application"）setobjword=objwordapp.documents.addobjword.application.Visible=true
objword.application.selection.paste
setobjword=nothing
setobjwordapp=nothing
升级会员 