EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub ShowPicture()
Dim r As String
Dim imgIcon
On Error Resume Next
ActiveSheet.Shapes(1).Delete
r = Range("AA1").Value
With Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278")
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
Width:=344, Height:=253)
End With
Set imgIcon = Nothing
End Sub
Code: Select all
On Error Resume Next
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 3) = "Pic" Then
shp.Delete
End If
Next shp
r = Range("AA1").Value
For Each Rng In Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278")
With Rng
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
Width:=344, Height:=253)
End With
Next Rng
Set imgIcon = Nothing
Code: Select all
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$AA$1" Then
Call ShowPicture
End If
Application.EnableEvents = True
End Sub
Code: Select all
Dim r As String
Dim imgIcon
On Error Resume Next
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 3) = "pic" Or Left(shp.Name, 3) = "รูป" Then
shp.Delete
End If
Next shp
r = Range("AA1").Value
For Each Rng In Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278")
With Rng
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
Width:=342, Height:=251)
End With
Next Rng
Set imgIcon = Nothing
ลองสูตรแล้วครับ Error ครับsnasui wrote: ตัวอย่างการปรับ Code ตามด้านล่างครับ
ถ้าภาพมีอยู่จริงตาม Folder ทีกำหนดไว้ใน Code จะต้องได้คำตอบครับCode: Select all
Dim r As String Dim imgIcon On Error Resume Next For Each shp In ActiveSheet.Shapes If Left(shp.Name, 3) = "pic" Or Left(shp.Name, 3) = "รูป" Then shp.Delete End If Next shp r = Range("AA1").Value For Each Rng In Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278") With Rng Set imgIcon = ActiveSheet.Shapes.AddPicture( _ Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _ SaveWithDocument:=True, Left:=.Left, Top:=.Top, _ Width:=342, Height:=251) End With Next Rng Set imgIcon = Nothing
ชื่อ. รูปภาพ 1.....รูปภาพ 10 ครับsnasui wrote: รูปมีชื่อว่าอะไรครับ
คลิกที่รูปแล้วดูที่ Name Box (กล่องซ้ายสุดบน Formula Bar) จะเห็นชื่อรูป แจ้งชื่อนั้นมาครับ
ทำ on error resume next ให้เป็น comment ไปก่อน แล้วลองดีบักด้วยการคลิกในโค้ดแล้วกด F8 ซ้ำ ๆ ดูว่าติดบรรทัดไหนจะได้ช่วยกันดูได้ครับsnasui wrote: ตัวอย่างการปรับ Code ตามด้านล่างครับ
ถ้าภาพมีอยู่จริงตาม Folder ทีกำหนดไว้ใน Code จะต้องได้คำตอบครับCode: Select all
Dim r As String Dim imgIcon On Error Resume Next For Each shp In ActiveSheet.Shapes If Left(shp.Name, 3) = "pic" Or Left(shp.Name, 3) = "รูป" Then shp.Delete End If Next shp r = Range("AA1").Value For Each Rng In Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278") With Rng Set imgIcon = ActiveSheet.Shapes.AddPicture( _ Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _ SaveWithDocument:=True, Left:=.Left, Top:=.Top, _ Width:=342, Height:=251) End With Next Rng Set imgIcon = Nothing
If Left(shp.Name, 3) = "pic"
If Ucase(Left(shp.Name, 3)) = "PIC"
ลองแล้วไม่ลบครับDhitiBank wrote:จากโค้ดเดิม
If Left(shp.Name, 3) = "pic"
ลองปรับเป็นแบบนี้ดูครับ
If Ucase(Left(shp.Name, 3)) = "PIC"