谁能给指导一下，错误位置应该怎么改

zaibuo · 发表于 2016-9-5 14:11

被人小白一枚，请指点错误位子应该怎么更改

opiona · 发表于 2016-9-6 08:16

你要干什么？
没有附件，没有需要说明
猜都不知道从何处开始！

zaibuo · 发表于 2016-9-6 08:20

opiona 发表于 2016-9-6 08:16
你要干什么？
没有附件，没有需要说明
猜都不知道从何处开始！

按目录内的文件名（模糊搜索），批量插入对象

wj2368 · 发表于 2016-9-6 10:06

。。。。。。。。。。。。。

opiona · 发表于 2016-9-6 10:18

Sub 批量插入WORD对象()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SH1 = Worksheets("Sheet1")
For Each SHAP In SH1.Shapes
If SHAP.Type = msoEmbeddedOLEObject Then SHAP.Delete
Next SHAP
Dim RA As Range
For I = 2 To SH1.Range("D65536").End(3).Row
PathG = ThisWorkbook.Path & "" & SH1.Cells(I, 4).Value & ".docx" '//指定文件路径
If FSO.FileExists(PathG) = True Then '//如果文件存在
Rem 对象文件名,对象链接到该文件,图标或正常图片方式,指定图标文件,图标序号,图标下方显示一个标签
Rem 指定位置和大小，图标就不会相互重叠最后还有个括号
Set RA = SH1.Range("E" & I)
Set Obj = SH1.OLEObjects.Add(Filename:=PathG, Link:=True, DisplayAsIcon:=True _
, IconFileName:=ThisWorkbook.Path & "\ICO.ICO", IconIndex:=0, IconLabel:=PathG _
, Left:=RA.Left + 3 _
, Top:=RA.Top + 3 _
, Height:=SH1.Rows(RA.Row).RowHeight - 6 _
, Width:=RA.Width - 6 _
)
With Obj
.Select '//声明为：Obj 是为了可能的其他操作
Rem 把行高改为与图标文件一样高，图标就不会相互重叠
SH1.Rows(I).RowHeight = .Height + 6
End With
Else
SH1.Cells(I, 5).Value = "没有此文件"
End If
Next I
End Sub

复制代码

opiona · 发表于 2016-9-6 10:20

插入word对象.rar (34.59 KB, 下载次数: 32)

		自动登录	找回密码
密码			免费注册

[求助] 谁能给指导一下，错误位置应该怎么改