實用文檔第頁竭誠為您提供優質文檔/雙擊可除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