VB 如何控制WORD中插入图片的大小等属性?
自己录个宏,稍加改动就可以了。
Sub 图片旋转270度对齐页面()'图片排版270度 If Selection.InlineShapes.Count = 0 Then If Selection.ShapeRange.Count 0 Then Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.AlternativeText = "Higer标书工具修改" Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Rotation = 270# Selection.ShapeRange.Width = CentimetersToPoints(28.9) Selection.ShapeRange.Height = CentimetersToPoints(20.2) 'Selection.ShapeRange.PictureFormat.Brightness = 0.5 'Selection.ShapeRange.PictureFormat.Contrast = 0.5 'Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic Selection.ShapeRange.PictureFormat.CropLeft = 0# Selection.ShapeRange.PictureFormat.CropRight = 0# Selection.ShapeRange.PictureFormat.CropTop = 0# Selection.ShapeRange.PictureFormat.CropBottom = 0# 'Selection.ShapeRange.Left = 90.1 'Selection.ShapeRange.Top = 88.15 'Selection.ShapeRange.Left = -120.45 'Selection.ShapeRange.Top = 109.1 Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeHorizontalPositionPage Selection.ShapeRange.RelativeVerticalPosition = _ wdRelativeVerticalPositionPage Selection.ShapeRange.Left = wdShapeCenter Selection.ShapeRange.Top = wdShapeCenter Selection.ShapeRange.LockAnchor = False Selection.ShapeRange.LayoutInCell = True Selection.ShapeRange.WrapFormat.AllowOverlap = True Selection.ShapeRange.WrapFormat.Side = wdWrapBoth Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0) Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0) Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32) Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32) Selection.ShapeRange.WrapFormat.Type = 3 Selection.ShapeRange.ZOrder 4 Selection.ShapeRange.ZOrder msoSendBackward End If End If If Selection "" Then If Selection.InlineShapes.Count 0 Then 'Selection.InlineShapes(1).Fill.Visible = msoFalse 'Selection.InlineShapes(1).Fill.Solid 'Selection.InlineShapes(1).Fill.Transparency = 0# 'Selection.InlineShapes(1).Line.Weight = 0.75 'Selection.InlineShapes(1).Line.Transparency = 0# 'Selection.InlineShapes(1).Line.Visible = msoFalse 'Selection.InlineShapes(1).LockAspectRatio = msoFalse 'Selection.InlineShapes(1).Width = CentimetersToPoints(28.9) 'Selection.InlineShapes(1).Height = CentimetersToPoints(20.2) 'Selection.InlineShapes(1).PictureFormat.Brightness = 0.5 'Selection.InlineShapes(1).PictureFormat.Contrast = 0.5 'Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic 'Selection.InlineShapes(1).PictureFormat.CropLeft = 0# 'Selection.InlineShapes(1).PictureFormat.CropRight = 0# 'Selection.InlineShapes(1).PictureFormat.CropTop = 0# 'Selection.InlineShapes(1).PictureFormat.CropBottom = 0# Selection.InlineShapes(1).ConvertToShape '属性转换(InlineShapes(1)转换为ShapeRange) Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.AlternativeText = "Higer标书工具修改" Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Width = CentimetersToPoints(28.9) Selection.ShapeRange.Height = CentimetersToPoints(20.2) Selection.ShapeRange.Rotation = 270# 'Selection.ShapeRange.PictureFormat.Brightness = 0.5 'Selection.ShapeRange.PictureFormat.Contrast = 0.5 'Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic Selection.ShapeRange.PictureFormat.CropLeft = 0# Selection.ShapeRange.PictureFormat.CropRight = 0# Selection.ShapeRange.PictureFormat.CropTop = 0# Selection.ShapeRange.PictureFormat.CropBottom = 0# Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeHorizo...
vb 如何插入图片
VB中插入加载图片步骤:1、打开VB,建立标准EXE。
2、建立一个图像框,名字改为p1,建立一个命令按钮。
3、双击命令按钮,进入代码编辑器,p1.Picture = LoadPicture("D:\My Documents\新建文件夹 (2)\1.jpg")4、点击运行。
5、点击命令按钮,图片显示出来了。
...
用VB向WORD插入图片的问题,请有经验的给教教我,怎么样能精确...
在VB6.0中,操作word,使用它强大的查找、替换、删除、复制、翦切功能。
还可以把特定字符替换成图片。
有了它你就可以使用数据库中的内容或图片文件替换word文件中的特定字符。
只要把下列内容复制到写字板中,另存为SetWord.cls文件,然后在把它添加到工程中,就可以使用了。
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "SetWord" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Private mywdapp As Word.Application Private mysel As Object'属性值的模块变量 Private C_TemplateDoc As String Private C_newDoc As String Private C_PicFile As String Private C_ErrMsg As Integer Public Event HaveError() Attribute HaveError.VB_Description = "出错时激发此事件.出错代码为ErrMsg属性"'***************************************************************'ErrMsg代码:1-word没有安装 2 - 缺少参数 3 - 没权限写文件' 4 - 文件不存在''*************************************************************** Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As Integer Attribute ReplacePic.VB_Description = "查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时,替换所有"'********************************************************************************' 从Word.Range对象mysel中查找所有FindStr,并替换为PicFile图像' 替换次数由time参数确定,为0时,替换所有'******************************************************************************** If Len(C_PicFile) = 0 Then C_ErrMsg = 2 Exit Function End If Dim i As Integer Dim findtxt As Boolean mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = "".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=True) If Not findtxt Then ReplacePic = 0 Exit Function End If i = 1 Do While findtxt mysel.InlineShapes.AddPicture FileName:=C_PicFile If i = Time Then Exit Do i = i + 1 mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=True) Loop ReplacePic = i End Function Public Function FindThis(FindStr As String) As Boolean Attribute FindThis.VB_Description = "查找FindStr,如果模板中有FindStr则返回True" If Len(FindStr) = 0 Then C_ErrMsg = 2 Exit Function End If mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = "".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With mysel.HomeKey Unit:=wdStory FindThis = mysel.Find.Execute End Function Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0) As Integer Attribute ReplaceChar.VB_Description = "查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时,替换所有"'********************************************************************************' 从Word.Range对象mysel中查找FindStr,并替换为RepStr' 替换次数由time参数确定,为0时,替换所有'******************************************************************************** Dim findtxt As Boolean If Len(FindStr) = 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Function End If mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = RepStr.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With If Time > 0 Then For i = 1 To Time mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=wdReplaceOne) If Not findtxt Then Exit For Next If i = 1 And Not findtxt Then ReplaceChar = 0 Else ReplaceChar = i End If Else mysel.Find.Execute Replace:=wdReplaceAll End If End Function Public Function GetPic(PicData() As Byte, FileName As String) As Boolean Attribute GetPic.VB_Description = "把图像数据PicData,存为PicFile指定的文件"'********************************************************************************' 把图像数据PicData,存为PicFile指定的文件'*********************************************...
转载请注明出处51数据库 » vb word 插入图片