ACCESS表中只是保存了图片的名称，在将数据导入EXCEL中时，如何显示相应名称的图片。

Question

部分代码如下，请高手帮忙改，在Cells(2, 12)这列显示图片，而不是图片的名称。谢谢！
sExcelPath = File_Save("Excel文件(*.xls)|*.xls", "导出产品信息")
If sExcelPath <> "" Then
On Error GoTo err:
Set Excel = GetObject(, "Excel.Application") ' Create Excel Object.
    
    Exit Sub
err:
    Set Excel = CreateObject("Excel.Application") 'Create Excel Object.
    Set ExcelWBk = Excel.Workbooks.Add 'Add this Workbook to Excel.
    Set ExcelWS = ExcelWBk.Worksheets(1) ' Add this sheet to this Workbook
    
    ExcelWS.Range("A1:L1").MergeCells = True
    ExcelWS.Cells(1, 1) = "******实业有限公司"
    ExcelWS.Range("A2:A3").MergeCells = True
    ExcelWS.Range("B2:B3").MergeCells = True
    ExcelWS.Range("C2:C3").MergeCells = True
    ExcelWS.Range("D2:D3").MergeCells = True
    ExcelWS.Range("E2:E3").MergeCells = True
    ExcelWS.Range("F2:H2").MergeCells = True
    ExcelWS.Range("I2:J2").MergeCells = True
    ExcelWS.Range("K2:K3").MergeCells = True
    ExcelWS.Range("L2:L3").MergeCells = True
    Dim row As Integer    row = 4     With Adodc1.Recordset
        .MoveFirst
        ExcelWS.Cells(2, 1) = UCase(.Fields(0).Name)   '产品编号
        ExcelWS.Cells(2, 2) = UCase(.Fields(1).Name)   '规格品名
        ExcelWS.Cells(2, 3) = UCase(.Fields(2).Name)   '花样
        ExcelWS.Cells(2, 4) = UCase(.Fields(3).Name)   'FOB价格
        ExcelWS.Cells(2, 5) = UCase(.Fields(4).Name)   '包装率
        ExcelWS.Cells(3, 6) = UCase(.Fields(5).Name)   '长
        ExcelWS.Cells(3, 7) = UCase(.Fields(6).Name)   '宽
        ExcelWS.Cells(3, 8) = UCase(.Fields(7).Name)   '高
        ExcelWS.Cells(3, 9) = UCase(.Fields(8).Name)   '净重
        ExcelWS.Cells(3, 10) = UCase(.Fields(9).Name)  '毛重
        ExcelWS.Cells(2, 11) = UCase(.Fields(10).Name) '备注
        ExcelWS.Cells(2, 12) = UCase(.Fields(11).Name) '图片
        ExcelWS.Cells(2, 6) = "包装尺码"               '包装尺码
        ExcelWS.Cells(2, 9) = "重量"                   '重量
        
    
    
    
        Do While Not Adodc1.Recordset.EOF  'populate with first 100 records
             For i = 1 To 12
                 ExcelWS.Cells(row, i) = .Fields(i - 1).Value
                 DoEvents
             Next
             row = row + 1 ' increment row
             Me.Caption = row & " records added"
             .MoveNext
        Loop
    End With
     ExcelWBk.SaveAs sExcelPath
     ExcelWBk.Close
     Excel.Quit
     MsgBox "信息成功到入到EXCEL中！", vbExclamation + vbOKOnly, pTitle
     
Else
    MsgBox "请选择保存路径！", vbOKOnly + vbDefaultButton1 + vbExclamation
End If

Answer 1

图片存储在 App.Path & "\photo\"

Answer 2

給你看一個例子，這是我寫的程序Private Sub PrintButton_Click()
On Error GoTo ErrHandle
    Dim xlApp As New Excel.Application
    Dim xlBook As New Excel.Workbook
    Dim xlSheet As New Excel.Worksheet
    Dim strsql As String
    Dim rsPict As New ADODB.Recordset
    
    If RichTextBox1.Text = "" Then
        MsgBox "沒有輸入工號﹐每次可輸入9人工號", vbExclamation, "提醒您"
        Exit Sub
    End If    Screen.MousePointer = 11
    strsql = "SELECT A.person_no,A.person_name,B.dept_name,A.photo" & _
            " FROM person A LEFT JOIN (SELECT position.position_no,position.name,position.dept_no,dept.name AS dept_name FROM position LEFT JOIN dept ON left(position.dept_no,1)+'0000'=dept.dept_no)B" & _
            " ON A.position_no=B.position_no " & _
            " where A.photo is not null and A.enable='1' and A.person_no in(" & RichTextBox1.Text & ")"
            
    rsPict.Open strsql, pubConn, 1, 1
    If rsPict.EOF Then
        Exit Sub
    End If
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("\\SWEB\Excel\PrintPhoto.xls")
    Set xlSheet = xlBook.Worksheets(2)
    xlApp.Visible = False    rsPict.MoveFirst
    Dim ZX As Single, ZY As Single
    Dim i As Integer, j As Integer
    
    With Image1
        .Stretch = False
        .Visible = False
        .Picture = LoadPicture("\\SWEB\datafile\photo\employee\24115.jpg")
        ZX = .Width / 3000     '假設目標寬度155圖元
        ZY = .Height / 3500    '假設目標高度165圖元       .Stretch = True
       .Height = Int(.Height / ZY)
       .Width = Int(.Width / ZX)
    End With
    
    i = 0
    j = 0
    Do While Not rsPict.EOF
        xlSheet.Shapes.AddPicture rsPict.Fields(3).Value, False, True, X1(i), Y1(j), ZX * 32, ZY * 37
        xlSheet.Shapes.AddPicture "\\SWEB\datafile\photo\employee\logo.jpg", False, True, X2(i), Y2(j), ZX * 15, ZY * 8
        
        xlSheet.Cells(X3(i), Y3(i)) = AddSpace(rsPict.Fields(2).Value)
        xlSheet.Cells(X3(i) + 2, Y3(i)) = Space(5) & "工號:" & rsPict.Fields(0).Value
        xlSheet.Cells(X3(i) + 3, Y3(i)) = Space(5) & "姓名:" & IIf(Len(rsPict.Fields(1).Value) = 2, Left(rsPict.Fields(1).Value, 1) + Space(2) + Right(rsPict.Fields(1).Value, 1), rsPict.Fields(1).Value)
        rsPict.MoveNext
        i = i + 1
        j = j + 1
    Loop
    
    xlSheet.Cells(1, 1).Select
    xlApp.Visible = True
    
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Screen.MousePointer = 0
    
    Exit Sub
ErrHandle:
    MsgBox "發生意外錯誤,請查看輸入的工號是否正確﹖", vbExclamation, "提醒您"
    Screen.MousePointer = 0
    
End Sub

Answer 3

對應的數組Public Sub Init_Array()
    X1(0) = 48
    X1(1) = 220
    X1(2) = 393
    X1(3) = 48
    X1(4) = 220
    X1(5) = 393
    X1(6) = 48
    X1(7) = 220
    X1(8) = 393
    Y1(0) = 13
    Y1(1) = 13
    Y1(2) = 13
    Y1(3) = 276
    Y1(4) = 276
    Y1(5) = 276
    Y1(6) = 539
    Y1(7) = 539
    Y1(8) = 539
    
    X2(0) = 68
    X2(1) = 240
    X2(2) = 413
    X2(3) = 68
    X2(4) = 240
    X2(5) = 413
.............
    
    X3(0) = 2
    X3(1) = 2
    X3(2) = 2
    X3(3) = 10
..............
End Sub

Answer 4

自己搞定了
将下面的
For i = 1 To 12
    ExcelWS.Cells(row, i) = .Fields(i - 1).Value
    DoEvents
Next
改为:
For i = 1 To 12
    If i = 12 Then
    xlsphotopath = App.Path & "\photo\" & .Fields(i - 1).Value
    L = "L" & row
    Range(L).Select
    ExcelWS.Pictures.Insert(xlsphotopath).Select
    With Selection
         .Placement = xlMoveAndSize
         .PrintObject = True
    End With
    Else
        ExcelWS.Cells(row, i) = .Fields(i - 1).Value
    End If
    DoEvents
Next没有试 hdhai9451(Water Space--海洋空間) 的,但是还是感谢你!!