在Microsoft Word中的标题内移动图像; Visual Basic

时间:2016-02-04 15:40:40

标签: vba ms-word vb6 ms-office

我有一个标题,我想在它旁边添加一个图像。我使用此代码插入它,它只是位于左上角。生成报告时看起来很好,但是当我打印报告时,徽标的最上面和左上部分会被切断。我如何以不同的方式定位?

Dim SHP As InlineShape
Dim SHT As Shape

With w_Wrd.Selection
    .Font.Reset
    .Font.Bold = True
    .Font.Color = wdColorBlack
    .Font.Name = "Times New Roman"
    .Font.Size = 14
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .TypeText " Needs Assessment"
End With
   Set SHP = w_Wrd.Selection.InlineShapes.AddPicture(FileName:="Q:\IS\LOGO\letetrhead.png", _
                        LinkToFile:=False, _
                        SaveWithDocument:=True)

    With SHP
        .Height = InchesToPoints(0.9)
        .Width = InchesToPoints(1.4)
        .ConvertToShape
    End With

编辑:

Per Cindy,我添加了这段代码,但是我得到了一个TYPE MISMATCH ERROR

  Set SHPP = shp.ConvertToShape --- new code
  SHPP.Left = InchesToPoints(0.1)---new code
  SHPP.Top = InchesToPoints(0.1) --- new code

EDIT上方的部分已被注释掉(使用shp .height等)

当我尝试运行此代码时,它适用于左侧,但是当我为.top执行此操作时告诉我OBJECT已被删除

    With SHP
        .Height = InchesToPoints(0.9)
        .Width = InchesToPoints(1.4)
        .ConvertToShape.left=inchesToPoints(.1)
        .converttoshape.top=InchesToPoints(.1) --- error HERE
    End With

这是我的功能,它基本上完成了我的整个报告。在大多数情况下,DIM都以模块化级别声明,但我粘贴了此函数中引用的内容。

Dim w_Wrd As Word.Application
Dim w_Temp As Word.Application
Dim w_Doc As Word.Document
Dim w_Rng As Word.Range

Private Function Export_To_Word_Doc(ByVal g_clientID As Long)
On Error GoTo error_handler:

Set w_Recordset = New ADODB.Recordset

With w_Doc.PageSetup
    .LineNumbering.Active = False
    .Orientation = wdOrientPortrait
    .TopMargin = w_Wrd.InchesToPoints(0.22)
    .BottomMargin = w_Wrd.InchesToPoints(0.24)
    .LeftMargin = w_Wrd.InchesToPoints(0.5)
    .RightMargin = w_Wrd.InchesToPoints(0.5)
    .Gutter = w_Wrd.InchesToPoints(0)
    .HeaderDistance = w_Wrd.InchesToPoints(0.5)
    .FooterDistance = w_Wrd.InchesToPoints(0.5)
    .PageWidth = w_Wrd.InchesToPoints(8.5)
    .PageHeight = w_Wrd.InchesToPoints(11)
    .FirstPageTray = wdPrinterDefaultBin
    .OtherPagesTray = wdPrinterDefaultBin
    .SectionStart = wdSectionNewPage
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .VerticalAlignment = wdAlignVerticalTop
    .SuppressEndnotes = False
    .MirrorMargins = False
    .TwoPagesOnOne = False
    .GutterPos = wdGutterPosLeft
End With

w_Wrd.Selection.Font.Name = "Times New Roman"
w_Wrd.Selection.ParagraphFormat.LineSpacing = 12
w_Wrd.Selection.ParagraphFormat.SpaceAfter = 0
w_Wrd.Selection.Font.Color = wdColorBlack

Call ResetFont(w_Wrd)
w_DocTblIdx = 1

'***** PAGE HEADER
If w_Wrd.ActiveDocument.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    w_Wrd.ActiveDocument.ActiveWindow.Panes(2).Close
End If

If w_Wrd.ActiveDocument.ActiveWindow.ActivePane.View.Type = wdNormalView Or _
   w_Wrd.ActiveDocument.ActiveWindow.ActivePane.View.Type = wdOutlineView Then
    w_Wrd.ActiveDocument.ActiveWindow.ActivePane.View.Type = wdPrintView
End If
w_Wrd.ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

With w_Wrd.Selection
    .Font.Reset
    .Font.Bold = True
    .Font.Color = wdColorBlack
    .Font.Name = "Times New Roman"
    .Font.Size = 14
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .TypeText " Needs Assessment "
End With
Dim SHPP As Shape
Dim shp As InlineShape
   Set shp = w_Wrd.Selection.InlineShapes.AddPicture(FileName:="Q:\IS\LOGO\letetrhead.png", _
                        LinkToFile:=False, _
                        SaveWithDocument:=True)

  With shp
     .Height = InchesToPoints(0.7)
     .Width = InchesToPoints(1.2)
     .ConvertToShape.Left = InchesToPoints(0.1)
  End With

在此代码下面,我继续页脚然后填写报告。除徽标外,一切正常。谢谢!

编辑3

Dim shpp As Shape
Dim shp As InlineShape
   Set shp =  w_Wrd.Selection.InlineShapes.AddPicture(FileName:="Q:\IS\CEDAR\letetrhead.png", _
                        LinkToFile:=False, _
                        SaveWithDocument:=True)


set shpp = shp.ConvertToShape

  With shpp
    .Left = InchesToPoints(0.1)
    .Top = InchesToPoints(0.1)
  End With

当我进入SET时,我得到一个TYPE MISMATCH ERROR。

0 个答案:

没有答案