Question

我想编写一个宏代码，它会将我本地目录中的文件加载到Excel的Excel表格中（＆＃34; C＆＃34;），文件上的名称应与列上的名称相匹配（＆＃34; ; B＆＃34）。如果任何文件找不到列B中给出的名称，则应跳过该行加载文件并继续下一列。我很难写，因为我是VB的新手。我尝试了但是，我的脚本正在从目录加载文件并加载名称。请帮忙！！谢谢大家，

代码：

Sub Insert_OLE_Object()
    Dim mainWorkBook As Workbook

    Set mainWorkBook = ActiveWorkbook
    Set ActiveSheet = example1

    Folderpath = "C:\Documents and Settings\my\Desktop\folder1"
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files

    For Each fls In listfiles
        Counter = Counter + 1
        Range("B" & Counter).Value = fls.Name
        strCompFilePath = Folderpath & "\" & Trim(fls.Name)
        If strCompFilePath <> "" Then
            Worksheets("Example1").OLEObjects.Add(Filename:=strCompFilePath, Link:=False, DisplayAsIcon:=True, IconIndex:=1, IconLabel:=strCompFilePath, Left:=20, Top:=40, Width:=150, Height:=10).Select
            Sheets("example1").Activate
            Sheets("example1").Range("C" & ((Counter - 1) * 3) + 1).Select
        End If
    Next
End Sub

Answer 1

试试这段代码：

Sub Insert_OLE_Object()
    Dim ws As Worksheet
    Dim rng As Range, c As Range
    Dim strCompFilePath As String, Folderpath As String, fullpath As String
    Dim obj As Object

    Application.ScreenUpdating = False
    'change to suit
    Set ws = ThisWorkbook.Worksheets("Example1")

    'change B1:B5 to suit
    Set rng = ws.Range("B1:B5")
    Folderpath = "C:\Documents and Settings\my\Desktop\folder1"

    For Each c In rng
        strCompFilePath = Dir(Folderpath & "\" & Trim(c.Value) & ".*")
        'if file with this name found, embed it
        If strCompFilePath <> "" Then
            fullpath = Folderpath & "\" & strCompFilePath
            Set obj = ws.OLEObjects.Add(Filename:=fullpath, Link:=False, _
                                        DisplayAsIcon:=True, IconIndex:=1, _
                                        IconLabel:=fullpath)
            With obj
                .Left = c.Offset(, 1).Left
                .Top = c.Offset(, 1).Top
                .Width = c.Offset(, 1).ColumnWidth
                .Height = c.Offset(, 1).RowHeight
            End With
        End If
    Next

    Application.ScreenUpdating = True
End Sub

VB脚本用于从范围B上的指定名称加载本地目录中的对象

1 个答案: