ขอสูตรการ Cut และ Paste Special รูปภาพแบบ type JPG

[nakhonchai]

ผมจำเป็นต้องทำการเอารูปภาพลงไฟล์ excel หลายๆภาพ เวลาบันทึกไฟล์จะหนักมากทำให้เวลาส่ง E-Mail ส่งไม่ได้
ซึ่ง E-Mail ในบริษัทจะห้ามส่งเกินขนาด 10 Mb.
รูปภาพที่เอาลงทุกครั้งผมจะ Crop เอาจุดที่ต้องการแสดงให้เห็นชัดเจนครับ
ผมลองหาวิธีบันทึกให้ไฟล์ excel มีขนาดเล็กหลายวิธีมาก รวมถึงใช้โปรแกรม FastStone Photo Resizer ไฟล์ก้อยังมากอยู่
พบว่าต้องทำการ cut และ Paste Special รูปภาพให้เป็นแบบ type JPG จะเล็กที่สุด
จึงอยากขอให้อาจารย์ช่วยหน่อยครับ
รบกวนขอการ cut และ Paste Special รูปภาพแบบ type JPG หน่อยครับ
โดยมี Step ดังนี้ครับ
- Click ที่รูปภาพที่ผ่านการ Crop แล้ว
- Click Cell ที่ต้องการเอาลง
- เมื่อรูปลงที่ Cell จะมีขนาดเท่า Cell นั้นๆ

ผมได้แนบไฟล์ตัวอย่างมาให้แล้วครับ
ขอบคุณมากครับ

Code: Select all

Sub Test01()

    Selection.Cut
    Range("B3").Select
    ActiveSheet.PasteSpecial Format:="Picture (JPEG)", Link:=False, _
        DisplayAsIcon:=False
        
End Sub

[snasui]

ลากรูปไปวางให้ทับเซลล์ที่ต้องการใส่รูปแล้ว Run Code ด้านล่างครับ

Code: Select all

Sub Test01()
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .Top = .TopLeftCell.Top
        .Left = .TopLeftCell.Left
        .Height = .TopLeftCell.Height
        .Width = .TopLeftCell.Width
    End With
End Sub

[nakhonchai]

สวัสดีครับอาจารย์
ผมลองแล้วลากรูปไปวางทับเซลล์ที่ต้องการแล้ว Run Code
แต่เรื่องเวลา Save file ขนาด Size ของไฟล์ยังไม่เล็กลงครับ
ผมได้ทำขั้นตอนวิธีการทำให้ไฟล์มีขนาด Size เล็กลงแนบมาให้แล้วครับ
- ไฟล์แรกแบบมีรูปก่อนทำการ Cut และ Paste Special type JPEG
- ไฟล์ที่สองขั้นตอนการทำแบบปกติ
รบกวนอาจารย์ช่วยดูและพิจารณาด้วยครับ
#ขอบคุณอาจารย์มากครับ

[menem]

ปกติถ้าเป็นการย่อขนาดของรูปภาพ (ในแง่ File Size)
ที่แนบไปกับ Excel ผมจะใช้วิธีวางรูปภาพ (และ Crop)
ให้ครบก่อน

จากนั้นใช้ Mouse click เพื่อเลือกรูปภาพ 1 รูป
แล้วกด Ctrl-A เพื่อให้เลือกทุกรูปใน Sheet นั้น ๆ
แล้วใช้ Format Ribbon เลือก Compress Picture
เลือกขนาดที่เล็กที่สุดแล้วกด OK ครับ

เท่าที่ทำมา ขนาดของไฟล์ Excel ลดลงมาก โดยไม่ต้อง
สนใจว่ารูปที่นำมาวางเป็น Type อะไรนะครับ


ส่วนตัวนี้เท่าที่ค้นได้จากใน Internet ครับ

Code: Select all

Sub Macro1()
    ActiveSheet.Pictures.Select
    SendKeys "%e", True
    SendKeys "~", True
    Application.CommandBars.ExecuteMso "PicturesCompress"
    Range("A1").Select
End Sub

แล้วเลือก 96-ppi กด OK ครับ

[snasui]

แต่เรื่องเวลา Save file ขนาด Size ของไฟล์ยังไม่เล็กลงครับ

เพราะ Code นั้นไม่ได้จัดการเรื่องขนาดไฟล์ครับ

จะต้องจัดการเรื่องขนาดไฟล์เสียก่อนจะด้วย Manual หรืออื่น ๆ ตามที่ได้อธิบายมา ซึ่งผมเข้าใจว่าทำในขั้นตอนนี้ไปเรียบร้อยแล้ว

Code ที่ผมเขียนเป็นการจัดการต่อจากนั้น คือจัดภาพให้พอดีเซลล์เท่านั้นครับ