สอบถามการ Merge Cell Center Picute VBA

[primeval]

ต้องการให้รูปภาพอยู่ตรงกลาง Merge & Center โดยอยากให้ VBA เลือกรูปภาพเองแล้ว Move ไปที่ A4 จากนั้นคำสั่งก็จะทำการปรับรูปภาพแล้ว Center รูปภาพครับ

Code: Select all

Sub FitPicture()
On Error GoTo NOT_SHAPE
Dim r As Range, sel As Shape
Set sel = ActiveSheet.Shapes(Selection.Name)

sel.LockAspectRatio = msoTrue
Set r = Range(sel.TopLeftCell.MergeArea.Address)
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.ShapeRange.Left = [A11].Left
Selection.ShapeRange.Top = [A11].Top
Select Case (r.Width / r.Height) / (sel.Width / sel.Height)
    Case Is > 1
        sel.Height = r.Height * 0.9
    Case Else
        sel.Width = r.Width * 0.9
End Select
sel.Top = r.Top + (r.Height - sel.Height) / 2
sel.Left = r.Left + (r.Width - sel.Width) / 2
Exit Sub
NOT_SHAPE:
MsgBox "Please select a picture first."
End Sub

รูปอยู่ตรงกลางพร้อม Merge cell.xlsm

[snasui]

ปัจจุบันปัญหาคืออะไรแจ้งมาด้วย ผมทดสอบแล้วไม่เกิดปัญหาใดครับ

[primeval]

อยากให้ VBA เลือกรูปได้เองโดยที่ไม่ต้อง Click และขยาย Scale รูปให้เท่ากับช่อง Cell ได้ครับ

[snasui]

จาก Statement นี้ Set sel = ActiveSheet.Shapes(Selection.Name) เป็นการเลือกรูปเอาไว้ก่อนโดยผู้ใช้ หากต้องการให้โปรแกรมเลือกเอง สามารถเปลี่ยนเป็น Set sel = ActiveSheet.Shapes(1) หมายถึงเลือก Shapes (ในที่นี้คือรูป) ที่ 1 ครับ

[primeval]

จาก Statement นี้ Set sel = ActiveSheet.Shapes(Selection.Name) เป็นการเลือกรูปเอาไว้ก่อนโดยผู้ใช้ หากต้องการให้โปรแกรมเลือกเอง สามารถเปลี่ยนเป็น Set sel = ActiveSheet.Shapes(1) หมายถึงเลือก Shapes (ในที่นี้คือรูป) ที่ 1 ครับ

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

[snasui]

หากทราบว่าชื่ออะไรก็เขียนชื่อนั้นเข้าไปแทนเลข 1 ได้เลยครับ

สังเกตว่า Code เดิมมีการใช้ Selection.Name นั่นแสดงว่าสามารถนำชื่อ Object ที่ต้องการเข้ามาใช้ได้โดยตรง