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

1.ความกว้างของ cell Range("f52:j86") กับ Range("m52:s86") ไม่เท่ากัน
ลองทดสอบโดยการขยายความกว้างของ cell m52 ก็ได้ แล้วดู ความสูงของภาพจะเปลี่ยนไป
แล้วจะเห็นความสัมพันธ์ ค่ะ
2.เรื่องขนาดไฟล์ ไม่เข้าใจตรง ตัดภาพวาง เป็น JPG ถึงจะได้ไฟล์ที่เล็กลง

จริงๆถ้าเป็นภาพเดิมไม่ได้ตกแต่งเพิ่ม ก็ไม่น่าจะเกี่ยวกัน อันนี้ไม่ทราบ

Quote:

---

Originally Posted by pooky

1.ความกว้างของ cell Range("f52:j86") กับ Range("m52:s86") ไม่เท่ากัน
ลองทดสอบโดยการขยายความกว้างของ cell m52 ก็ได้ แล้วดู ความสูงของภาพจะเปลี่ยนไป
แล้วจะเห็นความสัมพันธ์ ค่ะ
2.เรื่องขนาดไฟล์ ไม่เข้าใจตรง ตัดภาพวาง เป็น JPG ถึงจะได้ไฟล์ที่เล็กลง

จริงๆถ้าเป็นภาพเดิมไม่ได้ตกแต่งเพิ่ม ก็ไม่น่าจะเกี่ยวกัน อันนี้ไม่ทราบ

---

งานที่ได้มาทดสอบแล้วค่ะ ว่าขนาดไฟล์ต่างกันมาก ไฟล์ที่ได้มีจำนวนมากต่ออาทิตย์ เพราะต้องแยกส่งให้ supplier และส่งเมล์ จำเป็นต้องหาวิธีการทำให้เล็กมากที่สุด ก็คือตัดภาพแล้ววางเป็น jpg ที่ excel จะทำให้ภาพเล็กลงค่ะ:yesnod:

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

Quote:

---

Originally Posted by widtara

งานที่ได้มาทดสอบแล้วค่ะ ว่าขนาดไฟล์ต่างกันมาก ไฟล์ที่ได้มีจำนวนมากต่ออาทิตย์ เพราะต้องแยกส่งให้ supplier และส่งเมล์ จำเป็นต้องหาวิธีการทำให้เล็กมากที่สุด ก็คือตัดภาพแล้ววางเป็น jpg ที่ excel จะทำให้ภาพเล็กลงค่ะ:yesnod:

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

---

ใช้อะไรตัดหรือค่ะ และยังต้องการ ใช้vba ให้แทรกภาพอีกหรือเปล่า

Quote:

---

Originally Posted by pooky

ใช้อะไรตัดหรือค่ะ และยังต้องการ ใช้vba ให้แทรกภาพอีกหรือเปล่า

---

งานอ้อยมีขั้นตอนดังนี้ค่ะ
:type:
1.มี data อยู่หนึ่งไฟล์จัดเรียงข้อมูล 1 บรรทัดต่อข้อมูลออกมาเป็น 1 report
2.ข้อมูลเพิ่มลงมาด้านล่างเรื่อยๆ
3.จัดทำฟอร์ม report 1 ไฟล์ โดยมี sheet ส่งค่า 1 sheet ค่ะ และมี เป็น 100 sheet รับค่าแสดงเป็น 1 รายงาน เพราะแต่ละ sheet เป็นข้อมูลที่ต่างกัน แต่อยู่ใน from เดียวกัน เหมือนตัวอย่างที่ให้ดึงภาพนะค่ะ
4.เมื่อได้ report แล้วก็ทำการแยก sheet ออกมา 1 sheet ต่อ 1ไฟล์ เพราะเราแยกส่งให้ supplier ต่างเจ้ากันค่ะ

5.แต่ละไฟล์ก็มีภาพอธิบายปัญหา ก่อนหน้านี้ อ้อยต้องคลิกขวา new book ค่ะ หันมาใช้สูตร แยกชีท และให้บันทึกและปิดไฟล์อัตโนมัติ โดยมีทีมงานคุณภาพนี้ละค่ะช่วยเหลือ
:type:
6.จะมีทีมงานอ้อยที่บริษัทเขาต้องมาใส่ภาพลักษณะแบบที่เจอนะค่ะ ตกอาทิตย์หนึ่งก็เยอะมาก โดย การแทรกภาพค่ะ เมื่อได้ภาพแล้ว ลอง save ดูนะค่ะ ขนาดไฟล์จะใหญ่พอดู แต่เมื่อคลิกขวาที่ภาพ และวางใหม่เป็น jpg และ save ค่ะ ขนาดจะลดลงมา
อันนี้ ผู้จัดการแนะนำให้ทำ ค่ะ + จำเป็น เพราะต้องแนบไฟล์ส่งเมล์เยอะมาก

:type:
7.เลยคิดว่าถ้าแยก sheet อยู่แล้วก็ให้ไปดึงภาพพร้อมกันเลย จะลดเวลาทำงานลงมาก
+ตอนนี้ที่บริษัทไม่มีใครรู้เรื่อง VBA เลย อ้อยกำลัง ทดลองทำให้ใครๆเห็น ประโยชน์ของ VBA ด้วยค่ะ

22-24 ที่ผ่านมาก็ไปเรียนกับอาจารย์สมเกียรติที่ สสท มา แต่อะไรๆก็ยังไม่ลงตัวกับเอง ก็ต้องคอยทดสอบทบทวนหาวิธีทำไปเรื่อยๆค่ะ มีประโยชน์มาก แต่ก็พยายามปรับให้เข้ากับงานที่สุดค่ะ

ที่ไปเรียนเป็น 2003 แต่ที่บริษัท เป็น 2007 ทั้งหมด เขาเปลี่ยนทั่วโลกเฉพาะบริษัทอ้อยค่ะ อย่างที่รู้ 2007 ยังมีข้อบกพร่องที่เยอะ จนบางครั้งหลายคนบอกว่าก็ยกเลิกใช้ไป ทำไม่ได้เหรอค่ะ เพราะบริษัทเปลี่ยน นี้ยังดีนะค่ะ ที่ไม่บล๊อคเว็บนี้ ที่บริษัทยังเข้าได้อยู่ ไม่อย่างนั้น แย่เลย:rolleyes5:


:hand: เพิ่มเติมค่ะ อย่างไรก็ต้องใช้ VBA + กับการมานั่งจัดภาพอีกครั้งค่ะ เพราะภาพต้องมีการชี้ลูกศรถึงปัญหา วงกลมสีแดงบ้างอธิบายเพิ่มเติมด้วยซึ่งนอกเหนือจากสูตรแล้ว เพราะเป็นงานคุณภาพเราต้องอธิบายงานที่ค่ะ ซึ่งเป็นการออก report อธิบายการเสียหายของ part ต้องบอกจุดเสียหายเพิ่มเติมเพื่อชี้แจงปัญหา งานถึงจะสมบูรณ์ค่ะ ส่งภาพเปล่าอย่างเดียวไม่ได้ เพราะเป็นการหักเงินค่ะ

ผมแนะนำเกี่ยวกับเรื่องภาพ ว่าให้เราวาด image tool ก่อนแล้วก็สั่ง image โหลดภาพอีกที ขนาดภาพจะขึ้นอยู่กับ ขนาด tool ไม่ได้ขึ้นกับขนาดของfileภาพครับ ไม่รู้ว่าจะตรงกับความต้องการหรือเปล่านะครับ ปล ไม่ได้อ่านตั้งแต่ comment แรกนะครับ แต่คิดว่าน่าจะเป็นลักษณะดึงภาพมาแล้ววางตรงๆเลย

น่าจะลองวิธีแทรกภาพลงใน Chart

Quote:

---

Originally Posted by neang

ผมแนะนำเกี่ยวกับเรื่องภาพ ว่าให้เราวาด image tool ก่อนแล้วก็สั่ง image โหลดภาพอีกที ขนาดภาพจะขึ้นอยู่กับ ขนาด tool ไม่ได้ขึ้นกับขนาดของfileภาพครับ ไม่รู้ว่าจะตรงกับความต้องการหรือเปล่านะครับ ปล ไม่ได้อ่านตั้งแต่ comment แรกนะครับ แต่คิดว่าน่าจะเป็นลักษณะดึงภาพมาแล้ววางตรงๆเลย

---

สรุปได้ไอเดียเรื่องการทำให้ภาพมีขนาดเท่ากัน

ตอนนี้แต่ละไฟล์มี ความต้องการดึงภาพ 1 และ 2 มา สังเกตุว่า ภาพที่ 1 กับ 2 ไม่เท่ากัน ทั้งที่ภาพจริงเท่ากันค่ะ

วิธีแก้ไขค่ะ

With ActiveSheet.Pictures.Insert(Selection.Value)
.Top = Range("f55:j86").Top
.Left = Range("f55:j86").Left
If .Height > .Width Then
.Height = Range("f55:j80").Height
Else
.Width = Range("f55:j80").Width
End If
End With
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"
With ActiveSheet.Pictures.Insert(Selection.Value)
.Top = Range("m55:s86").Top
.Left = Range("m55:s86").Left
If .Height > .Width Then
.Height = Range("m55:s86").Height
Else
.Width = Range("m55:s86").Width
End If
End With


หลังจากนั้นที่ไฟล์

.Top = Range("m55:s86").Top
.Left = Range("m55:s86").Left

.Height = Range("f55:j80").Height
.Width = Range("f55:j80").Width

รองรับภาพที่ 1

.Top = Range("m55:s86").Top
.Left = Range("m55:s86").Left
.Height = Range("m55:s86").Height
.Width = Range("m55:s86").Width

รองรับภาพที่ 2

ที่ไฟล์ excel แค่อ้อยปรับ ความกว้าง*ยาว ของ เซลล์ ในช่วง 2 ช่วงให้เท่ากัน ภาพก็เท่ากันแล้วค่ะ

ไม่ต้องสร้างอะไรเพิ่มเติมเลยค่ะ

ขอบคุณทีมงานทุกคนที่คอยให้กำลังใจและช่วยเหลือมาโดยตลอดค่ะ จะนำงานนี้ไปพัฒนาให้ดีกว่านี้แล้วจะกลับมารายงานค่ะ

Quote:

---

ขอปรับปรุงcodeใหม่ เนื่องจากทดลองแล้ว code จะให้ปรับขนาดภาพตาม Height หรือ Width
อย่างไดอย่างหนึ่งแล้วอีกด้านจะขยายตามเอง ปัญหาคือถ้าตั้งให้ขยายตาม Width ภาพที่มีขนาดHeight>Widthจะล้นลงมาด้านล่าง

---

Quote:

---

ความกว้างของ cell Range("f52:j86") กับ Range("m52:s86") ไม่เท่ากัน
ลองทดสอบโดยการขยายความกว้างของ cell m52 ก็ได้ แล้วดู ความสูงของภาพจะเปลี่ยนไป
แล้วจะเห็นความสัมพันธ์ ค่ะ

---

2 post ที่แล้ว คือคำตอบ ว่าทำไมไม่เท่ากัน

เรื่องราวปัญหายุ่งๆของการเรื่อง ภาพก็ยังไม่จบมาดูปัญหาภาคต่อนะค่ะ

R:\SQA DEDUCT PAYMENT Y11\EVENT PICTURES TOP LOAD\wk26\RJ LT\105980

DSC00097.JPG
DSC00098.JPG
DSC00099.JPG
Thumbs.db

ภาพรวมของภาพใน Folders ค่ะ 105980 เป็นชื่อ ma ก่อนที่สูตรจะทำงาน อ้อยต้องทำการเปลี่ยนชื่อไฟล์ภาพ 2 ภาพ
DSC00098.JPG เปลี่ยนเป็น 1.JPG
DSC00099.JPG เปลี่ยนเป็น 2.JPG

ส่วนภาพแรกไม่ต้องการ และจะมีไฟล์ Thumbs.db ติดมาทุก Foldersค่ะ

ปัญหาคือ มี Folders แบบนี้ประมาณ 200 Folders ขึ้นไป และมี ภาพข้างใน 3 ภาพ ชื่อภาพได้จากกล้องเรียงจากน้อยไปมาก

ชื่อภาพน้อยสุดไม่เอา เริ่มเอาภาพ ถัดไป 2 ภาพ
ต้องมาเปลี่ยนชื่อภาพซึ่งไม่ไหวเยอะมาก เพื่อให้สูตรทำงานตามเงื่อนไข

อยากทราบว่าท่านใดมีวิธีแก้ไขปัญหาของโจทย์นี้ไหมค่ะ
1.ต้องการเอาภาพที่ 2 และ 3 ถัดจากภาพที่มีเลขท้ายน้อยที่สุด ส่วนใหญ่การถ่ายภาพของทีมงานจะเป็นแบบนี้
2.ชื่อภาพจะไม่เหมือนกัน เพราะได้จากกล้องเลยต้องกำหนดเป็นภาพที่ 2 และ 3 ที่มีเลขมากเป็นอันดับ 2 และ 3 ค่ะ
3.กำหนดให้ VBA เลือกมาใส่เองอัตโนมัติจากเงื่อนไขเบี้องต้นค่ะ

ใครช่วยได้ช่วยทีนะค่ะ จะเป็นพระคุณอย่างสูงค่ะ

Code:

---

Sub RenameInFolder(ByVal FD As String)
Dim FN As String, FileList() As String
Dim I As Integer, J As Integer, Temp As String
Dim MinFN1 As String, MinFN2 As String
If Right(FD, 1) <> "\" Then FD = FD & "\"
FN = Dir(FD & "*.JPG")
Do While Len(FN) > 0
    ReDim Preserve FileList(I)
    FileList(I) = FN
    FN = Dir()
    I = I + 1
Loop
If I < 3 Then
    MsgBox FD & " only " & I & " files"
    Exit Sub
End If
For I = 0 To UBound(FileList) - 1
    For J = 1 To UBound(FileList)
        If FileList(I) > FileList(J) Then
            Temp = FileList(I)
            FileList(I) = FileList(J)
            FileList(J) = Temp
        End If
    Next
Next
Name (FD & FileList(1)) As (FD & "1.JPG")
Name (FD & FileList(2)) As (FD & "2.JPG")
End Sub

---

วิธีเรียกใช้
RenameInFolder "R:\SQA DEDUCT PAYMENT Y11\EVENT PICTURES TOP LOAD\wk26\RJ LT\105980"
อย่าลืม Backup file ก่อนทดลองนะคะ