返回列表 上一主題 發帖

[發問] 自動插入圖片

參考 GBKEE 大
http://forum.twbts.com/thread-11280-1-1.html


Option Explicit
Sub JpgInsert()
    Dim Mypath As String, E As Range, x%, y%   ', MyPic As Object
    Mypath = "D:\JPG\"
    Application.ScreenUpdating = False

    With Sheets("Sheet1")
        .Pictures.Delete '刪除全部圖片
        For y = 0 To 9
            For x = 0 To 2
                Set E = Cells(5 + 8 * y, 1 + x * 3)
'                E.Resize(8).ColumnWidth = 30     '調整儲存格寬度
'                E.Resize(8).RowHeight = 20        '調整儲存格高度
                If Dir(Mypath & E(2, 2) & ".jpg") <> "" Then
                    'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
                    With .Pictures.Insert(Mypath & E(2, 2) & ".jpg")
                        .ShapeRange.LockAspectRatio = msoFalse '圖形比例 msoTrue / msoFalse=填滿格
                        .Left = E.Resize(8).Left
                        .Top = E.Resize(8).Top
                        .Width = E.Resize(8).Width   '=儲存格寬度
                        .Height = E.Resize(8).Height '=儲存格高度
                    End With
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 3# 建銘

範例檔案,請下載參考
http://www.FunP.Net/420075

插入圖片.rar (1 MB)
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 4# c_c_lai

謝謝指正
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 8# 建銘


Mypath = ThisWorkbook.Path & "\"    ' "D:\JPG\" '圖片檔案放置目錄

改為
Mypath = "D:\JPG\" '圖片檔案放置目錄
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

        靜思自在 : 受人點水之恩,須當湧泉以報。
返回列表 上一主題