Page 1 of 1

Coppy sheet พร้อมกับ Insert picture รูปเก่ายังติดมา macro

Posted: Mon Apr 28, 2014 9:24 am
by pramot55
ผมมี sheet list ที่เก็บ ID องหลายๆคนไว้
และ sheet test เป็นต้นแบบที่ต้อง coppy
ใช้ macro โดยชื่อของ sheet ใหม่จะเป็น ID และ Insert picture (จาก folder ชื่อรูปเป็น ID)ไปพร้อมๆกัน ส่วนชื่อ picture ก็เป็น ID เช่นกัน
ปัญหาก็คือ เมื่อ coppy sheet กับ insert picture รูปเก่าจะ เข้ามาด้วย เช่น คนที่ 2 มี รูป 1 2 คนที่ 5 มีรูป 1 2 3 4 5 ทับกันอยู่

Sub coppySheet()
Dim i As Integer
Dim x As String 'x is ID



For i = 1 To 5 'loop for create sheet

ActiveSheet.Copy Workbooks("Book1.xlsm").Worksheets("test") ' coppy pattern
x = Worksheets("list").Range("B" & i)
ActiveSheet.Name = x 'Name of this sheet

Worksheets(x).Range("C1") = Worksheets("list").Range("B" & i) 'sid


ActiveSheet.Pictures.Insert("C:\Users\ARt\Desktop\Pic\" & x & ".jpg").Select 'Path to where pictures are stored

With Selection 'Resize picture and point of picture
.Left = Range("p3").Left
.Top = Range("p3").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 130#
.ShapeRange.Width = 100#
.ShapeRange.Rotation = 0#

End With



Next i

End Sub


หาโค้ดมาจาก http://en.kioskea.net/faq/6485-excel-a- ... t-pictures

Re: Coppy sheet พร้อมกับ Insert picture รูปเก่ายังติดมา macr

Posted: Mon Apr 28, 2014 9:35 am
by pramot55
ไฟล์รูปคับ

Re: Coppy sheet พร้อมกับ Insert picture รูปเก่ายังติดมา macr

Posted: Mon Apr 28, 2014 3:38 pm
by tupthai
ลองเปลี่ยนจาก

Code: Select all

ActiveSheet.Copy Workbooks("Book1.xlsm").Worksheets("test") ' coppy pattern
เป็น

Code: Select all

Sheets("test").Copy After:=Sheets(Worksheets.Count)

Re: Coppy sheet พร้อมกับ Insert picture รูปเก่ายังติดมา macr

Posted: Mon Apr 28, 2014 4:06 pm
by pramot55
tupthai wrote:ลองเปลี่ยนจาก

Code: Select all

ActiveSheet.Copy Workbooks("Book1.xlsm").Worksheets("test") ' coppy pattern
เป็น

Code: Select all

Sheets("test").Copy After:=Sheets(Worksheets.Count)


ทำได้แล้วครับขอบคุณครับ :thup: :thup: :thup: