vba 基于单元格嵌入OLE对象
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/26911105/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Embed OLEobject based on cell
提问by bordeltabernacle
I want to embed an OLEObject (text file) in Excel, with the filename being derived from a particular cell. I can do this as a one off action but am now trying to make it work in a loop through all the cells in a column, finishing when it comes across an empty cell.
我想在 Excel 中嵌入一个 OLEObject（文本文件），文件名来自特定单元格。我可以将其作为一次性操作来完成，但现在我试图让它在一个列中的所有单元格中循环工作，当它遇到一个空单元格时完成。
I can't seem to get the right syntax to make the If/Else loop work:
我似乎无法获得正确的语法来使 If/Else 循环工作：
Sub Insert_Text_File()
Dim ol As OLEObject
Dim path As String
Dim file As String
Dim filenameinvisible As String
Dim rangeA As Range
Dim rangeD As Range
path = ActiveWorkbook.Path
file = Range(i,1).Value & "-Live" & ".txt"
Set rangeA = Range("A" & i)
Set rangeD = Range("D" & i)
For i = 2 To 200
If Range("A" & i) <> "" Then
Set ol = Worksheets("Inventory").OLEObjects.Add (Filename:= path & "\" & file, Link:=False, DisplayAsIcon:=True, Height:=10)
ol.Top =Range("D" & i).top
ol.left=Range("D" & i).left
End If
Next i
End Sub
采纳答案by bordeltabernacle
I think the problem with your current approach is that your are assigning the value to the pathvariable only once - file = Range(i,1).Value & "-Live" & ".txt"before the loop increases i.
我认为您当前方法的问题在于您只将值分配给path变量一次 -file = Range(i,1).Value & "-Live" & ".txt"在循环增加之前i。
A better approach requiring less variables would be using a for eachloop using a cellvariable of Rangetype and relying on VBA to find the last row used rather than hard-coding 200 into the loop.
需要更少变量的更好方法是使用for each使用类型cell变量的循环Range并依靠 VBA 来查找使用的最后一行，而不是将 200 硬编码到循环中。
Try this approach and let us know if that has worked.
试试这个方法，让我们知道它是否有效。
Sub Insert_Text_File()
Application.ScreenUpdating = False
Dim cell As Range
' loop each cell in column A
For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
' make sure the cell is NOT empty before doing any work
If Not IsEmpty(cell) Then
' create and insert a new OleObject based on the path
Dim ol As OLEObject
' ActiveWorkbook.path & "\" & cell & "-Live.txt" will make the filename
Set ol = ActiveSheet.OLEObjects.Add( _
Filename:=ActiveWorkbook.path & "\" & cell & "-Live.txt", _
Link:=False, _
DisplayAsIcon:=True, _
Height:=10)
' align the OleObject with Column D - (0 rows, 3 columns to the right from column A)
With ol
.Top = cell.Offset(0, 3).Top
.Left = cell.Offset(0, 3).Left
End With
End If
Next
Application.ScreenUpdating = True
End Sub
