Protect Sheet แต่ยัง Insert Picture ได้...

[mr.zatan]

ทำยังไงถึงจะ Protect Sheet แต่ยังสามารถ Insert Picture ได้...

[snasui]

ลองแนบไฟล์ตัวอย่างที่ Protect แล้ว Insert Picture ได้มาด้วย จะได้ช่วยตรวจสอบได้ครับ

[mr.zatan]

คือปรกติถ้า Protect Sheet แล้วจะไม่สามารถ Insert Picture ได้ใช่มัยครับ

แต่ที่ต้องการคือ จะ Insert Picture ใน Sheet ที่ Protect Sheet ไว้น่ะครับ

[snasui]

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

[mr.zatan]

สงสัยต้องใช้ VBA เข้ามาช่วยใช่มัยครับ งั้น....

ผมจะใช้ VBA ช่วยและกัน

ตามนี้ครับ...

- คือตอนนี้มันติดตรงที่ รูปที่ Insert เข้ามามันไม่อยู่ตรงกลางช่องน่ะครับ ช่วยแก้ให้หน่อยครับ...

- ให้อยู่ตรงกลางช่อง และ ปรับขนาดรูปให้พอดีกับช่อง

Code: Select all

Private Sub CommandButton1_Click()
  Dim sFile As Variant, r As Range
  Set r = Range("B11")
  sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
  If sFile = False Then Exit Sub
  ActiveSheet.Unprotect
  With ActiveSheet.Pictures.Insert(sFile).ShapeRange
	.LockAspectRatio = True
	.Top = r.Top
	.Left = r.Left
	.Height = r.RowHeight * r.MergeArea.Rows.Count
  End With
  ActiveSheet.Protect
End Sub

[snasui]

แนบไฟล์ตัวอย่าง ภาพตัวอย่างมาด้วย จะได้ช่วยทดสอบได้ครับ

[mr.zatan]

ไฟล์ตัวอย่างครับ..

- ให้รูปอยู่ในช่อง และตรงกลาง

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub CommandButton1_Click()
    Dim sFile As Variant, r As Range
    Dim imgIcon As Object
    Set r = Range("a5").MergeArea
    sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", _
        Title:="Browse to select a picture")
    If sFile = False Then Exit Sub
    ActiveSheet.Unprotect
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:=sFile, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=r.Left, _
        Top:=r.Top, _
        Width:=r.Width, _
        Height:=r.Height)
    ActiveSheet.Protect
End Sub

[mr.zatan]

ภาพมันยืด....น่ะครับ

อย่างถ้ารูปที่เป็น สี่เหลี่ยมจัตุรัตอย่างนี้ มันก็จะยืดเท่ากับช่องครับ

คือให้รูปอยุ่ในทรงเดิมๆๆ แค่ให้อยู่ตรงกลางครับ...

[snasui]

แก้ไขข้อความ ลบคำว่า "อ่ะ" ทิ้งไปครับ

ที่ปรับไปก่อนหน้านั้นเป็นการปรับตามที่เขียนมาครับ

- ให้อยู่ตรงกลางช่อง และ ปรับขนาดรูปให้พอดีกับช่อง

[mr.zatan]

โทษทีครับผมอธิบายไม่ค่อยตรง

- คือให้อยู่ตรงกลางโดยภาพไม่เสีย ขนาดจริง

- คลิกครั้งที่2 ให้ ลบรูปออก ผมสามารถใช้ Code นี้ได้ รึเปล่าว

Code: Select all

ActiveSheet.Pictures.Delete

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub CommandButton1_Click()
    Dim sFile As Variant, r As Range
    Set r = Range("a5").MergeArea
    sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
    If sFile = False Then Exit Sub
    ActiveSheet.Unprotect
    With ActiveSheet.Pictures.Insert(sFile).ShapeRange
        .LockAspectRatio = True
        .Top = r.Top + ((r.Height - .Height) / 2)
        .Left = r.Left + ((r.Width - .Width) / 2)
    End With
    ActiveSheet.Protect
End Sub

[snasui]

- คลิกครั้งที่2 ให้ ลบรูปออก ผมสามารถใช้ Code นี้ได้ รึเปล่าว

โค้ด:
ActiveSheet.Pictures.Delete

ลองเองได้เลยครับ หากไม่ได้แล้วค่อยแจ้งมาครับ

[mr.zatan]

เพิ่มเติมครับ

Code ส่วนนี้ ถ้าจะทำให้เพิ่มรูปที่ a10 ด้วยนี่ต้องเพิ่ม Code อะไรครับ

คือเพิ่มรูปที่ a5 และ a10 พร้อมกันรูปเดียวกัน

Code: Select all

Set r = Range("a5").MergeArea

[snasui]

ลองเขียนมาก่อนครับ ติดตรงไหนค่อยถามกันต่อครับ

ปกติหากเป็นรูปเดียวกันลองใช้การ Copy ไปวางครับ

[mr.zatan]

ผมลอง Set r = Range("a5","a10").MergeArea

ก็ไม่ได้

[snasui]

ลอง Copy ตามที่ผมแจ้งไปแล้วยังครับ

หากไม่ทราบว่าทำอย่างไรให้ลองบันทึก Macro แล้วดู Code ครับ

[mr.zatan]

คือผมหมายถึง..คลิกครั้งเดียวรูปเข้าพร้อมกัน 2 ช่องน่ะครับ

[snasui]

เข้าใจครับ แนบไฟล์ที่ลองเขียนมาเองแล้วและระบุมาด้วยว่าติดบรรทัดใดจะได้ปรับปรุงต่อไปจากนั้นครับ

วิธีการ Copy ที่ผมบอกก็ไม่ได้ให้ผลลัพธ์ที่แตกต่างกัน เราสามารถ Copy แล้ววางหลายพื้นที่ได้พร้อมกัน อยู่ที่การเขียน Code ครับ