WORD VBA 语法相关定位问题 求高手帮我看一下少了甚么步骤

kk_lee69

回复 15# yamakawa

就是真的不熟 才想出用PNG 的方法 是我可以理解的最簡單方式了   當然最好是 直接畫就好  但是真的不熟

yamakawa

回复 16# kk_lee69



只能祝你好运了。。。vba真的无能为力

oceanwind

http://club.excelhome.net/forum.php楼主的问题这里应该可以解决，不过你不妨把你带macro的word文件放上来看看，之前也作过一个移动图片的macro.

oceanwind

楼上有位朋友说的方法不错，在ps中有js脚本可以使用。

oceanwind

之前写的一个移动图片的片段。

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

kk_lee69

回复 20# oceanwind


    恩 這沒問題 下星期在把檔案放上來 在公司

不過 我的語法中已經是 全部VBA語法了....  

選定位置 複製圖片 然後再 做個日期的文字  然後把兩個組成一個圖片  就是上面與法

只是  定位不到一起 一定要 細部調整

等待 kevinch 老大出現

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

另外图片要去掉多余的白边，上面这段代码在不同版本中的表现可能会有差异

kk_lee69

回复 22# kevinch

感謝 老大的回覆

我在測試看看 研究一下 感謝

kk_lee69

回复 22# kevinch

試過了 搞不定  自己修改不了  不知道 是否 可以用我上面 那段的邏輯

幫我修改一下  確定可以執行的 .....

kevinch

高版本里可以完美实现，低版本里似乎文字垂直居中一句不行

kk_lee69

回复 25# kevinch


    我想這樣是有點誤會了
應該這樣說  我附上全部檔案 你就可以理解



附件中 圖片999 是獨立放在電腦的其他地方  本身WORD 沒有 圖片

然後 巨集的語法中  第一段 是要從電腦的絕對位置  插入999這張圖片

然後根據圖片所在位置加上 加上日期  

然後再把圖片與文字框 合成一個組合圖

圖片插入大小 需要保持 列印出來在大約 1.6CM

你可以看一下我的附件   原本一開始的寫法是 如這個話題一開始的語法

附件中  是我後來修改的

我們公司office 為2013

oceanwind

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

oceanwind

修改了一点点，我这边2013是可以用。

oceanwind

你传的图片象素是400点，改成word96点，应该大小各*0.4就行了。

kk_lee69

回复 29# oceanwind

感謝 我測試看看  
另外請教一下  您說的這句話  象素是400点，改成word96点，应该大小各*0.4

在談的是哪段的 算法??  老實說 像素 怎麼換算成  長寬 上面的數字 我也是 搞不太清楚