vba插入圖片問題 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » vba插入圖片問題

返回列表下一主題上一主題發帖

vba插入圖片問題

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2014-2-21 15:03 | 顯示全部帖子

回復 1# h99949

Option Explicit
Sub ChangeSize()
Dim Mypath As String, E As Range, MyPic As Object
Mypath = "D:\catalogue\"
With Sheets("工作表1")
.Pictures.Delete
For Each E In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
'For Each : 依序處裡集合的成員
'集合的成員: .Range("a2") 到 .Range("a" & .Rows.Count).End(xlUp))的儲存格
'(從最儲存格底部的列往到有資料的儲存格)
If Dir(Mypath & E & ".jpg") <> "" Then
Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
With MyPic
.ShapeRange.LockAspectRatio = msoFalse
.Left = E.Cells(1, 2).Left
.Top = E.Cells(1, 2).Top
.Width = E.Cells(1, 2).Width
.Height = E.Cells(1, 2).Height
End With
End If
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2014-2-21 18:23 | 顯示全部帖子

回復 3# h99949

Option Explicit
Sub ChangeSize()
Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
Mypath = "D:\catalogue\"
With Sheets("工作表1")
.Pictures.Delete
For i = 1 To 7 Step 3 'A欄 ->1,D欄 ->4,G欄 ->7
For Each E In .UsedRange.Columns(i).Cells ' 'A欄 ->1,D欄 ->4,G欄 ->7
If Dir(Mypath & E & ".jpg") <> "" Then
'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
With .Pictures.Insert(Mypath & E & ".jpg")
.ShapeRange.LockAspectRatio = msoFalse
.Left = E.Cells(1, 2).Left
.Top = E.Cells(1, 2).Top
.Width = E.Cells(1, 2).Width
.Height = E.Cells(1, 2).Height
End With
End If
Next
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2014-2-25 15:12 | 顯示全部帖子

回復 5# h99949

Option Explicit
Sub ChangeSize()
Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
Mypath = "D:\catalogue\"
With Sheets("工作表1")
.Pictures.Delete
For i = 1 To 7 Step 3 'A欄 ->1,D欄 ->4,G欄 ->7
For Each E In .UsedRange.Columns(i).Cells ' 'A欄 ->1,D欄 ->4,G欄 ->7
E.ColumnWidth = 25 '調整儲存格寬度
E.RowHeight = 50 '調整儲存格高度
If Dir(Mypath & E & ".jpg") <> "" Then
'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
With .Pictures.Insert(Mypath & E & ".jpg")
.ShapeRange.LockAspectRatio = msoFalse
.Left = E.Cells(1, 2).Left
.Top = E.Cells(1, 2).Top
.Width = E.Cells(1, 2).Width '=儲存格寬度
.Height = E.Cells(1, 2).Height '=儲存格高度
End With
End If
Next
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 心中常存善解、包容、感思、知足、惜福。

返回列表下一主題上一主題