vba-word表格插入图片

实用文档第页竭诚为您提供优质文档/双击可除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=tectcontents

nextw1

ifshtagthen

Foreachw1inworksheets

withw1

tectcontentsthen

onerrorResumenext

dodummydoloop

Fori=65to66:Forj=65to66:Fork=65to66

Forl=65to66:Form=65to66:Fori1=65to66

Fori2=65to66:Fori3=65to66:Fori4=65to66

Fori5=65to66:F