เพื่อมุ่งให้เกิดคุณภาพจากการอบรมสูงสุด Excel Expert Training ให้การอบรม Excel กลุ่มเล็กๆ ไม่เกิน 6 คนทุกคนสามารถเรียนรู้ Excel อย่างใกล้ชิด จะมาคนเดียวหรือมาเป็นกลุ่มแล้วนัดวันอบรมแบบส่วนตัวก็ได้ ผู้เข้าอบรมทุกคนสามารถติดตามเนื้อหาที่อบรมได้อย่างชัดเจนจากจอภาพด้านหน้าของตัวเอง
Page 2 of 7 FirstFirst 1234 ... LastLast
Results 11 to 20 of 65

Thread: ให้VBAหาภาพในfoldersและใส่ภาพในไฟล์excelอัตโนมัติ

  1. #11
    excel_fever
    Guest

    รบกวนแก้รหัสตรงสีแดงหน่อยครับ ขออภัย

    Sub Macro1()
    Dim i As Integer
    For i = 1 To ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(i).Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("O4").Value & Range("j13").Value & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
    Range("c43").Select
    Selection.FormulaR1C1 = "=R[71]C[1]&""\""&R[72]C[1]&""\""&""wk""&TEXT(WEEKNUM(R[-34]C[13],16),""00"")&""\""&R[74]C[1]&""\""&R[-12]C[13]&""\""&R[-14]C[7]&""\""&R120C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Range("k43").Select
    Selection.FormulaR1C1 = "=R[71]C[-7]&""\""&R[72]C[-7]&""\""&""wk""&TEXT(WEEKNUM(R[-34]C[5],16),""00"")&""\""&R[74]C[-7]&""\""&R[-12]C[5]&""\""&R[-14]C[7]&""\""&R121C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Application.DisplayAlerts = False
    ActiveWorkbook.Close True

    Next i
    End Sub

  2. #12
    excel_fever
    Guest
    รหัสใหม่หลังตัดโฟลเดอร์ Sub ออกไป

    Sub Macro1()
    Dim i As Integer
    For i = 1 To ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(i).Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("O4").Value & Range("j13").Value & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
    Range("c43").Select
    Selection.FormulaR1C1 = "=R[71]C[1]&""\""&R[72]C[1]&""\""&""wk""&TEXT(WEEKNUM(R[-34]C[13],16),""00"")&""\""&R[-12]C[13]&""\""&R[-14]C[7]&""\""&R120C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Range("k43").Select
    Selection.FormulaR1C1 = "=R[71]C[-7]&""\""&R[72]C[-7]&""\""&""wk""&TEXT(WEEKNUM(R[-34]C[5],16),""00"")&""\""&R[-12]C[5]&""\""&R[-14]C[-1]&""\""&R121C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Application.DisplayAlerts = False
    ActiveWorkbook.Close True

    Next i
    End Sub

    รหัสนี้จะแทรกภาพตามไดเรกทอรี่ที่คุณบอกมา ผมเองก็ไม่สร้างโฟลเดอร์จำลองขนาดนั้นแน่ ที่สำคัญก็อย่างที่บอกไปว่า"คำถาม VBA ผู้ถามควรจะประยุกต์เองได้บ้าง" ดังนั้น ตอนทดสอบผมตัดคำสั่งแทรกภาพออกไป ไฟล์ที่ถูกสร้างขึ้นนั้นจะมีสูตรเพิ่มขึ้นมา สังเกตดูที่พื้นที่ที่ต้องการแทรกภาพ(ในไฟล์ที่ถูกสร้างใหม่) แล้วไล่ดูว่ามีไฟล์/โฟลเดอร์อยู่จริงหรือเปล่า หากผิดแม้แต่อักขระเดียวก็ Error ครับ

  3. #13
    widtara
    Guest

    ขณะนี้ค่ะ

    Quote Originally Posted by excel_fever View Post
    รหัสใหม่หลังตัดโฟลเดอร์ Sub ออกไป

    Sub Macro1()
    Dim i As Integer
    For i = 1 To ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(i).Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("O4").Value & Range("j13").Value & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
    Range("c43").Select
    Selection.FormulaR1C1 = "=R[71]C[1]&""\""&R[72]C[1]&""\""&""wk""&TEXT(WEEKNUM(R[-34]C[13],16),""00"")&""\""&R[-12]C[13]&""\""&R[-14]C[7]&""\""&R120C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Range("k43").Select
    Selection.FormulaR1C1 = "=R[71]C[-7]&""\""&R[72]C[-7]&""\""&""wk""&TEXT(WEEKNUM(R[-34]C[5],16),""00"")&""\""&R[-12]C[5]&""\""&R[-14]C[-1]&""\""&R121C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Application.DisplayAlerts = False
    ActiveWorkbook.Close True

    Next i
    End Sub

    รหัสนี้จะแทรกภาพตามไดเรกทอรี่ที่คุณบอกมา ผมเองก็ไม่สร้างโฟลเดอร์จำลองขนาดนั้นแน่ ที่สำคัญก็อย่างที่บอกไปว่า"คำถาม VBA ผู้ถามควรจะประยุกต์เองได้บ้าง" ดังนั้น ตอนทดสอบผมตัดคำสั่งแทรกภาพออกไป ไฟล์ที่ถูกสร้างขึ้นนั้นจะมีสูตรเพิ่มขึ้นมา สังเกตดูที่พื้นที่ที่ต้องการแทรกภาพ(ในไฟล์ที่ถูกสร้างใหม่) แล้วไล่ดูว่ามีไฟล์/โฟลเดอร์อยู่จริงหรือเปล่า หากผิดแม้แต่อักขระเดียวก็ Error ครับ
    ตอนนี้ที่เจอค่ะ
    ActiveSheet.Pictures.Insert (Selection.Value) มัน error ตรงนี้ อ้อยก็ค่อยอ่านว่ามันเชื่อมกันยังงัย ให้เวลานิดหนึ่งนะค่ะ ตอนนี้พึ่งหัดทำ ยังมึนๆอยู่ค่ะ

  4. #14
    excel_fever
    Guest
    ไว้พรุ่งนี้จะสร้าง path จำลองเพื่อทดสอบจริง ๆ ให้ ผมก็อยากรู้เหมือนกัน

  5. #15
    widtara
    Guest

    แก้ไขไฟล์ให้เรียบร้อยแล้วทดลองใหม่ค่ะ

    Quote Originally Posted by excel_fever View Post
    ไว้พรุ่งนี้จะสร้าง path จำลองเพื่อทดสอบจริง ๆ ให้ ผมก็อยากรู้เหมือนกัน
    แก้ไขไฟล์ให้เรียบร้อยแล้วทดลองใหม่ค่ะ เอาไฟล์นี้ค่ะ ยังไม่ได้ใส่โค้ดอะไรตอนนี้มึนหัวมากเลยด้วยความอยากรู้ ค่ะ
    ที่อยู่ของ path ที่ทดลองค่ะ
    R:\SQA DEDUCT PAYMENT Y11\EVENT PICTURES TOP LOAD\wk04\RJ IT\82521\
    เข้าจะมีภาพ 1.jpg และ 2.jpg ค่ะ

  6. #16
    excel_fever
    Guest
    ทดสอบแล้วทำงานได้ครับ แต่ทดสอบแค่ชีตเดียว เวลานำไปใช้ เซลล์ D114 เปลี่ยน E ในไฟล์แนบ เป็น Drive จริงของเครื่องคุณ

    รหัสเดิมก็ใช้ได้ แต่ปรับใหม่นิดหน่อย

    Sub Macro1()
    Dim i As Integer
    For i = 1 To ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(i).Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("o4").Value & Range("j13").Value & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
    Range("c43").Select
    Selection.FormulaR1C1 = "=R[71]C[1]&""\""&R[72]C[1]&""\""&R[73]C[1]&""\""&R[74]C[1]&""\""&R[75]C[1]&""\""&R119C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Range("l43").Select
    Selection.FormulaR1C1 = "=R[71]C[-8]&""\""&R[72]C[-8]&""\""&R[73]C[-8]&""\""&R[74]C[-8]&""\""&R[75]C[-8]&""\""&R120C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Application.DisplayAlerts = False
    ActiveWorkbook.Close True
    Next i
    End Sub

  7. #17
    widtara
    Guest

    ดึงได้แล้วค่ะแต่ภาพไม่อยู่ในพื้นที่ที่กำหนด

    Quote Originally Posted by excel_fever View Post
    ทดสอบแล้วทำงานได้ครับ แต่ทดสอบแค่ชีตเดียว เวลานำไปใช้ เซลล์ D114 เปลี่ยน E ในไฟล์แนบ เป็น Drive จริงของเครื่องคุณ

    รหัสเดิมก็ใช้ได้ แต่ปรับใหม่นิดหน่อย

    Sub Macro1()
    Dim i As Integer
    For i = 1 To ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(i).Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("o4").Value & Range("j13").Value & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
    Range("c43").Select
    Selection.FormulaR1C1 = "=R[71]C[1]&""\""&R[72]C[1]&""\""&R[73]C[1]&""\""&R[74]C[1]&""\""&R[75]C[1]&""\""&R119C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Range("l43").Select
    Selection.FormulaR1C1 = "=R[71]C[-8]&""\""&R[72]C[-8]&""\""&R[73]C[-8]&""\""&R[74]C[-8]&""\""&R[75]C[-8]&""\""&R120C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Application.DisplayAlerts = False
    ActiveWorkbook.Close True
    Next i
    End Sub
    ดึงได้แล้วค่ะแต่ภาพไม่อยู่ในพื้นที่ที่กำหนด
    แต่จะไปอยู่ในช่วง D3 ถึง D20 และ ภาพ 2 ภาพ ก็ซ้อนทับกันอยู่ค่ะ
    ขนาดภาพ 16.92 x 22.57 และต้องการกำหนดให้ภาพมีขนาด 13 x 17.34 จะกำหนดได้ไหมค่ะ

  8. #18
    orange_soi9
    Guest
    Quote Originally Posted by widtara View Post
    ดึงได้แล้วค่ะแต่ภาพไม่อยู่ในพื้นที่ที่กำหนด
    แต่จะไปอยู่ในช่วง D3 ถึง D20 และ ภาพ 2 ภาพ ก็ซ้อนทับกันอยู่ค่ะ
    ขนาดภาพ 16.92 x 22.57 และต้องการกำหนดให้ภาพมีขนาด 13 x 17.34 จะกำหนดได้ไหมค่ะ
    ลองศึกษาและพยายามเขียน Code ด้วยตัวเองขึ้นมาก่อนดีไหมคะ? ถ้าลองพยายามทำแล้ว แต่ติดขัดปัญหาตรงไหนค่อยมาถามอีกทีนะคะ อาจารย์และทุกคนในที่นี้พร้อมช่วยอยู่แล้วค่ะ :smile:
    ลองดู Code จาก Link นี้เป็นตัวอย่างก่อนก็ได้นะคะ
    http://excel.bigresource.com/auto-in...-VrrpomxW.html

  9. #19
    excel_fever
    Guest
    Quote Originally Posted by excel_fever View Post
    Range("c43").Select
    Selection.FormulaR1C1 = "=R[71]C[1]&""\""&R[72]C[1]&""\""&R[73]C[1]&""\""&R[74]C[1]&""\""&R[75]C[1]&""\""&R119C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    Range("l43").Select
    Selection.FormulaR1C1 = "=R[71]C[-8]&""\""&R[72]C[-8]&""\""&R[73]C[-8]&""\""&R[74]C[-8]&""\""&R[75]C[-8]&""\""&R120C4"
    ActiveSheet.Pictures.Insert (Selection.Value)
    ภาพที่ 1 ถูกแทรกที่ C43
    ภาพที่ 2 ถูกแทรกที่ L43
    รหัสถูกต้องครับ ผมเองก็ทดสอบแล้ว
    และเรื่องขนาดภาพ ผมเคยเตือนตั้งแต่ตอนต้นแล้ว
    2. ภาพที่จะแทรก ควรจะผ่านการตกแต่งเรียบร้อยแล้ว (คือแทรกมาแล้วไม่ต้องมาย่อ/ขยาย
    หรือทำอะไรอีก) ทุกภาพ
    เรื่องทำได้หรือไม่ได้ จึงยังไม่ขอตอบครับ

  10. #20
    widtara
    Guest

    ลองทำดูอีกครั้ง

    Quote Originally Posted by excel_fever View Post
    ภาพที่ 1 ถูกแทรกที่ C43
    ภาพที่ 2 ถูกแทรกที่ L43
    รหัสถูกต้องครับ ผมเองก็ทดสอบแล้ว
    และเรื่องขนาดภาพ ผมเคยเตือนตั้งแต่ตอนต้นแล้ว

    เรื่องทำได้หรือไม่ได้ จึงยังไม่ขอตอบครับ
    ทดลองทำที่เครื่องอีกครั้ง ภาพก็ยังไม่อยู่ในตำแหน่งให้ค่ะ อ้อยแนบภาพมาให้ดู ค่ะ
    ไปเจอ code นี้ในเว็บที่คุณส้มให้มาก เกี่ยวกับการจัดการภาพ แต่ก็ประยุกต์ไม่เป็นค่ะ เลยเอามาให้ดูค่ะ

    Sub test()
    On Error Resume Next
    Set pic = ActiveSheet.Pictures.Insert("C:
    ange.gif")
    On Error Goto 0
    If Not pic Is Nothing Then 'Found it!'
    Set rng = ActiveCell
    With pic
    .Height = rng.Height
    .Width = rng.Width
    .Left = rng.Left
    .Top = rng.Top
    End With
    End If
    End Sub

    ส่วนบรรทัดนี้หมายความว่าอย่างไรค่ะ แปล code ไม่ออกค่ะ
    = "=R[71]C[1]&""\""&R[72]C[1]&""\""&R[73]C[1]&""\""&R[74]C[1]&""\""&R[75]C[1]&""\""&R119C4"

    Selection.FormulaR1C1 = "=R[71]C[-8]&""\""&R[72]C[-8]&""\""&R[73]C[-8]&""\""&R[74]C[-8]&""\""&R[75]C[-8]&""\""&R120C4"

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •