回复 15# yamakawa
就是真的不熟 才想出用PNG 的方法 是我可以理解的最簡單方式了 當然最好是 直接畫就好但是真的不熟
回复 16# kk_lee69
{:face (356):}只能祝你好运了。。。vba真的无能为力
http://club.excelhome.net/forum.php楼主的问题这里应该可以解决，不过你不妨把你带macro的word文件放上来看看，之前也作过一个移动图片的macro.
楼上有位朋友说的方法不错，在ps中有js脚本可以使用。
之前写的一个移动图片的片段。
Sub movepic(temp_splitn, temp_edge, temp_topwz) '移动图片位置
Dim mywidth, pgwd As Single
pgwd = 595.2755906 '此为A4无边距磅数宽度
Dim ii As Integer
For ii = temp_splitn To 1 Step -1
With ActiveDocument.Shapes("split#=" & ii)
mywidth = .Width'现图片宽度
myH = .Height '现图片高度
.Anchor.Cut
Selection.GoTo wdGoToPage, wdGoToAbsolute, , ii & ""
'ActiveDocument.Range(1, 1).Paste
Selection.Paste
End With
With ActiveDocument.Shapes("split#=" & ii)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = pgwd - mywidth - temp_edge '靠右边
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = temp_topwz
End With
Next
End Sub
回复 20# oceanwind
恩 這沒問題 下星期在把檔案放上來 在公司
不過 我的語法中已經是 全部VBA語法了....
選定位置 複製圖片 然後再 做個日期的文字然後把兩個組成一個圖片就是上面與法
只是定位不到一起 一定要 細部調整
等待 kevinch 老大出現
定位时要加上左边距和上边距，还有文字行的段落间距
Dim Sh As Object, PS As Object
Set Sh = ThisDocument.Shapes(1)
Set PS = ThisDocument.PageSetup
Sh.Select
With ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, Sh.Left + PS.LeftMargin, Sh.Top + PS.TopMargin + Selection.Information(wdVerticalPositionRelativeToTextBoundary), Sh.Width, Sh.Height)
.Line.Visible = msoFalse
.Fill.Transparency = 1
With .TextFrame
.VerticalAnchor = msoAnchorMiddle
With .TextRange
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Size = 24
.Font.ColorIndex = wdBlue
.Text = Format(Date, "yyyy.mm.dd")
End With
End With
End With
另外图片要去掉多余的白边，上面这段代码在不同版本中的表现可能会有差异
回复 22# kevinch
感謝 老大的回覆
我在測試看看 研究一下 感謝
回复 22# kevinch
試過了 搞不定自己修改不了不知道 是否 可以用我上面 那段的邏輯
幫我修改一下確定可以執行的 .....
高版本里可以完美实现，低版本里似乎文字垂直居中一句不行
回复 25# kevinch
我想這樣是有點誤會了
應該這樣說我附上全部檔案 你就可以理解
附件中 圖片999 是獨立放在電腦的其他地方本身WORD 沒有 圖片
然後 巨集的語法中第一段 是要從電腦的絕對位置插入999這張圖片
然後根據圖片所在位置加上 加上日期
然後再把圖片與文字框 合成一個組合圖
圖片插入大小 需要保持 列印出來在大約 1.6CM
你可以看一下我的附件 原本一開始的寫法是 如這個話題一開始的語法
附件中是我後來修改的
我們公司office 為2013
Sub insertpic()
'
' 筿?彻?ボ虫ノ
'
PLeft = Selection.Information(wdHorizontalPositionRelativeToPage)
PTop = Selection.Information(wdVerticalPositionRelativeToPage)
PLPOS = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
Dim Sh As Object, PS As Object
Set PS = ThisDocument.PageSetup
'MsgBox (PLeft & "" & PTop)
Dim arr(0 To 1) As Variant
Set myDocument = ActiveDocument
With myDocument.Shapes
With .AddPicture(FileName:="E:\Study\office\word\au3bbsproblem\2\999.jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=PS.LeftMargin, Top:=PS.TopMargin)
.Name = "shp1"
arr(0) = .Name
End With
Set Sh1 = ThisDocument.Shapes("shp1")
Sh1.Select
With ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, PS.LeftMargin, PS.TopMargin, Sh1.Width, Sh1.Height)
.Name = "shp2"
.Line.Visible = msoFalse
.Fill.Transparency = 1
With .TextFrame
.VerticalAnchor = msoAnchorMiddle
With .TextRange
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Size = 7.5
'.Font.Name = "夹发砰"
.Font.ColorIndex = wdBlue
.Text = Format(Date, "yyyy.mm.dd")
End With
End With
End With
Set Sh2 = ThisDocument.Shapes("shp2")
Dim target_left, target_top As Single
With Sh1
target_left = .Left
target_top = .Top
End With
With Sh2
.Left = target_left
.Top = target_top
End With
' With .Range(Array("shp1", "shp2")).Group
'.Fill.PresetTextured msoTextureBlueTissuePaper
'.Rotation = 45
' .ZOrder msoSendToBack
' End With
End With
End Sub
修改了一点点，我这边2013是可以用。
你传的图片象素是400点，改成word96点，应该大小各*0.4就行了。
回复 29# oceanwind
感謝 我測試看看
另外請教一下您說的這句話象素是400点，改成word96点，应该大小各*0.4
在談的是哪段的 算法??老實說 像素 怎麼換算成長寬 上面的數字 我也是 搞不太清楚