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

Thread: วิธี Import รูปมาใส่ใน cell ให้เท่ากับขนาดของ Cell ที่กำหนดไว้

  1. #1
    sirimno
    Guest

    วิธี Import รูปมาใส่ใน cell ให้เท่ากับขนาดของ Cell ที่กำหนดไว้

    กรณีที่เรากำหนดขนาดความกว้าง ความสูงของ cell ไว้
    แล้วเรา Import รูปมาใส่ใน Cell และต้องการให้ขนาดพอดีกะ cell ที่เรากำหนดไว้
    ต้องทำอย่างไร

    เพราะใช้คำสั่ง insert picture form file รูปที่ได้จะขนาดเท่ากับขนาดรูปจริง

    กรณีที่ต้องการนำรูปมาใส่ใน excel หลาย ๆ รูป แล้วต้องการให้ขนาดพอดี แต่ต้องไปเปลี่ยน size ของรูปใน file รูปภาพ หรือต้องมาปรับขนาดเอง ค่อนข้างเสียเวลามาก

    มีวิธีใดที่สามารถทำได้ง่าย ๆ กว่านี้หรือเปล่าคะ

  2. #2
    สมเกียรติ
    Guest
    ผมจะใช้โปรแกรมรูปภาพพวก Photoshop จัดการ resize รูปภาพที่เก็บไว้ก่อนรวดเดียวทั้งหมด จากนั้นจึง Insert เข้าตารางครับ

  3. #3
    XSale
    Guest

    ลองดู VBA ที่ผมเคยเขียนแล้วประยุกต์นะครับ

    Sub GetImage(ByRef PicRange As Range)
    On Error Resume Next
    Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog(1)
    With dlgOpen
    .Title = Range(ActiveCell.Address).Value
    .AllowMultiSelect = False

    .Filters.Clear
    .Filters.Add "Image", "*.jpg", 1
    .Filters.Add "Image", "*.jpeg", 2
    .FilterIndex = 1

    .Show
    If Not .SelectedItems.Count = 0 Then
    Call InsertPictureInRange(.SelectedItems(1), PicRange)
    End If
    End With

    End Sub

    Sub InsertPictureInRange(PictureFileName As String, ByRef PicRange As Range)
    On Error Resume Next
    UnProtectActiveSheet
    ' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With Range(ActiveCell.Address)
    t = .Top
    l = .Left
    w = .Offset(0, .Columns.Count).Left - .Left
    h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' position picture
    With p
    .Top = t
    .Left = l
    .Width = w
    .Height = h
    .Select
    .ZOrder (msoSendToBack)

    End With
    Set p = Nothing

    SendPictureToBack

    ProtectActiveSheet (False)
    End Sub

Similar Threads

  1. Replies: 2
    Last Post: 25 Oct 2009, 12:11
  2. Replies: 3
    Last Post: 30 Sep 2009, 11:29
  3. Replies: 3
    Last Post: 17 Sep 2009, 22:39
  4. Replies: 2
    Last Post: 24 Aug 2008, 12:11
  5. Replies: 8
    Last Post: 3 Aug 2007, 22:03

Posting Permissions

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