นำภาพมาแสดงใน Comment แบบ Dynamic ไม่ได้

[modtanoi]

สมาชิกใหม่...มือใหม่หัดทำ
ทดสอบทำตาม http://snasui.blogspot.com/2011/06/comment-dynamic.html แต่ทำไม่ได้ครับ
รบกวนช่วยแนะนำข้อผิดพลาดให้หน่อยนะครับ

Sheet1

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then
        ChangePicInComment
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$A$1" Then
        Application.DisplayCommentIndicator = xlCommentAndIndicator
    Else
        Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    End If
End Sub

Module

Code: Select all

Sub ChangePicInComment()
    Dim PicName As String
    On Error Resume Next
    PicName = Range("A1")
       Range("A1").Comment.Shape.Select
       Selection.ShapeRange.Fill.UserPicture "D:\" & PicName & ".jpg"
    Range("A1").Select
End Sub

[snasui]

การจะให้ภาพแสดงใน Comment ได้ต้อง Add Comment เอาไว้ก่อนครับ

ลองคลิกขวาที่ A1 แล้วเลือก Insert Comment จากนั้นทดสอบเลือก Validation ดูครับ

[modtanoi]

การจะให้ภาพแสดงใน Comment ได้ต้อง Add Comment เอาไว้ก่อนครับ

ลองคลิกขวาที่ A1 แล้วเลือก Insert Comment จากนั้นทดสอบเลือก Validation ดูครับ

ทำสำเร็จแล้วครับ
ขอบคุณมากครับ

[modtanoi]

สอบถามปัญหาเพิ่มเติมครับ
1. ผสานเซลล์ A B C แถวที่ 1 เข้าด้วยกัน เขียน code เลือกเซลล์ไม่ถูกต้องแก้ไขยังไงครับ (แต่ถ้าไม่ผสานเซลล์สามารถแสดงผลได้ครับ)
2. คัดลอกเซลล์ข้อ 1 วางซ้ำกันหลายแถว(ข้อมูลชุดเดียวกัน) เขียน code ให้แสดงผลยังไงครับ

ขอบคุณมากครับ

[snasui]

ช่วยโพสต์ Code ที่ลองเขียนเองแล้วมาด้วยครับ

[modtanoi]

ใช้สูตรเหมือนเดิมกับกระทู้ข้างบนครับแต่เปลี่ยนแค่ตำแหน่งจากเซลล์เดียวเป็นเซลล์ผสานแทนแต่ไม่แสดงผลครับ
เช่น ผสานเซลล์ A1:C1 ตำแหน่งเซลล์คือ A1 (เหมือน excel ระบุ) แต่ VBA ไม่รู้จักมั๊งครับ
ผมก็เลยลองเดาเปลี่ยนตำแหน่งแหน่งเซลล์ไปเลื่อยแต่ก็ทำไม่ได้ครับ หาทางออกไม่เจอเลยมาขอคำปรึกษาครับ
(มือใหม่หัดทำ หากรบกวนประการใดต้องขออภัยมา ณ ที่นี้ด้วยครับ)
ยกตัวอย่าง code ที่ผมลองเดาดูครับ อันนี้เป็นทำในเซลล์ผสานและหลายแถว(ข้อมูลชุดเดียวกัน)

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1:$A$10" Then
        ChangePicInComment
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$A$1:$A$10" Then
        Application.DisplayCommentIndicator = xlCommentAndIndicator
    Else
        Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    End If
End Sub

Code: Select all

Sub ChangePicInComment()
    Dim PicName As String
    On Error Resume Next
    PicName = Range("A1:A10")
       Range("A1:A10").Comment.Shape.Select
       Selection.ShapeRange.Fill.UserPicture "D:\Menu\" & PicName & ".jpg"
    Range("A1:A10").Select
End Sub

[snasui]

กรณีผสานเซลล์เช่น ผสาน A1:C1 เราสามารถเลือกใช้ Code Range("A1")(1) เพื่อเลือกเซลล์ที่ผสานกันได้ครับ

[modtanoi]

1. ทำตามที่แนะนำไม่สำเร็จเลยครับ
เปิดอ่านจากเว็ปอื่น ก็เดาอยู่หลายวิธีก็ยังทำไม่สำเร็จเหมือนกันครับ
ใครทำได้บ้างช่วยชี้แนะด้วยครับ

2. เพิ่มสูตรให้กับหลายแถว ทำกับ cell เดียวได้แต่ cell ผสามทำไม่ได้เช่นเดียวกันครับ(อันนี้ก็เดาจนปวดหัวเหมือนกันก็ยังไม่สำเร็จเลย)
ช่วยชี้แนะด้วยครับ

Code: Select all

Sub AddPics()
'
' AddPic# Macro
'

'
For Each Cell In Selection
    ThisPicture = "D:\Menu\" & Cell.Value & ".jpg"
    With Cell.AddComment
        .Shape.Fill.UserPicture ThisPicture
        .Shape.Fill.Transparency = 0#
        .Shape.Line.Weight = 0.75
        .Shape.Line.DashStyle = msoLineSolid
        .Shape.Line.Style = msoLineSingle
        .Shape.Line.Transparency = 0#
        .Shape.Line.Visible = msoTrue
        .Shape.Line.ForeColor.RGB = RGB(0, 0, 0)
        .Shape.Line.BackColor.RGB = RGB(255, 255, 255)
        .Shape.Fill.Visible = msoTrue
        .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Shape.Fill.BackColor.RGB = RGB(255, 255, 225)
        .Shape.LockAspectRatio = msoFalse
        .Shape.Height = 50.25
        .Shape.Width = 57.75
        ActiveCell.Comment.Visible = False
    End With
Next Cell
End Sub

ขอบคุณครับ

[snasui]

ลองแนบไฟล์มาครับเผื่อจะได้ปวดหัวน้อยลง ถ้าไม่แนบไฟล์โอกาสปวดหัวมีเท่าเดิมหรือมากขึ้นครับ

[modtanoi]

ก่อนส่งก็เดาไปหลายกระบวนท่า
รบกวนช่วยด่านแรกให้ผ่านหน่อยนะครับ (แสดงรูปในรายการ comment)
ด่านต่อไปแสดงรูปแบบมีเงื่อนไข IF
"ตาบอดถามทาง" ต้องขออภัย

[snasui]

จากกรณี Merge Cell และต้องการแสดง Comment หลาย ๆ เซลล์ ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    ChangePicInComment
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    If Not Target(1).Comment Is Nothing Then
        Target(1).Comment.Visible = True
    End If
End Sub

Sub ChangePicInComment()
    Dim PicName As String
    On Error Resume Next
    PicName = Selection(1).Value
    Selection(1).Comment.Shape.Select
    Selection.ShapeRange.Fill.UserPicture "D:\Menu\" & PicName & ".jpg"
    Selection(1).Select
End Sub

[modtanoi]

สงสัยปัญหาเพิ่มเติมครับ
1.ทำไมทำ cell เดียว --> แสดงรูปภาพใน comment แล้วไม่มีกรอบขยาย
แต่ทำใน merged cell --> แสดงรูปภาพใน comment แล้วมีกรอบขยาย
มีเทคนิคหรือวิธิเพิ่ม code ให้ไม่แสดงกรอบขยายเหมือนทำใน cell เดียวไหมครับ เพราะเวลาเลือกรายการจะได้ดูรูปง่ายๆ
3.การเปลี่ยนรูปไม่ค่อยราบรื่นเหมือน cell เดียว มีวิธีแก้ไขไหมครับ
cell เดียว --> กดปุ๊บ เปลี่ยนปั๊บ(ทุกครั้ง)
merged cell --> ครั้งแรกกดปุ๊บ เปลี่ยนปั๊บ ครั้งต่อไปไม่เปลี่ยน


ขอบคุณมากครับ

[snasui]

แนบภาพมาที่ฟอรัมนี้เลยครับ

ส่วน Code ได้ลองปรับแก้เองแล้วหรือไม่ครับ ช่วยโพสต์ที่ลองแก้เองด้วยครับ

[modtanoi]

เรียน อาจารย์

ปัญหาดังกล่าวข้างต้นสามารถแก้ไขได้(นาน)แล้วครับ แต่มีปัญหาใหม่เพิ่มเติมได้ลองทำ/เดามาหลายครั้งแต่ก็ทำไม่สำเร็จสักที รบกวนอาจารย์ช่วยดูให้หน่อยครับ
1. ซ่อน Comment ถ้าหากแถวนั้นไม่มีข้อความ เช่น การ Delete แถวให้ว่างไม่มีรายการ หรือ เลือกรายการว่างที่เตรียมไว้ใน List
2. ให้แสดง Comment ค้างไว้เฉพาะตอนที่คลิ๊กเลือกรายการหรือตำแหน่งเม้าท์มาชี้ หากเลื่อนเม้าท์ไปที่อื่นให้หายไป

ขอบคุณครับ

[modtanoi]

เรียน อาจารย์

ปัญหาดังกล่าวข้างต้นสามารถแก้ไขได้(นาน)แล้วครับ แต่มีปัญหาใหม่เพิ่มเติมได้ลองทำ/เดามาหลายครั้งแต่ก็ทำไม่สำเร็จสักที รบกวนอาจารย์ช่วยดูให้หน่อยครับ
1. ซ่อน Comment ถ้าหากแถวนั้นไม่มีข้อความ เช่น การ Delete แถวให้ว่างไม่มีรายการ หรือ เลือกรายการว่างที่เตรียมไว้ใน List ที่ทำได้คือไม่แสดงคอมเม้นค้างในแถวที่ไม่มีข้อมูล แต่ถ้าชี้เม้าท์มาใส่ก็แสดงเหมือนเดิมครับ อันนี้แก้ไม่ให้แสดงยังไม่ได้ครับ
2. ให้แสดง Comment ค้างไว้เฉพาะตอนที่คลิ๊กเลือกรายการหรือตำแหน่งเม้าท์มาชี้ หากเลื่อนเม้าท์ไปที่อื่นให้หายไป

ขอบคุณครับ

[snasui]

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

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static oldCell As Range
    On Error Resume Next
    oldCell.Comment.Select.Visible = False
    Target(1).Comment.Select.Visible = Ture
    Set oldCell = Target(1)
    Application.DisplayCommentIndicator = xlNoIndicator 'Change this line
    If Target(1).Value = "" Then
        Target(1).Comment.Hidden = Ture
    ElseIf Not Target(1).Comment Is Nothing Then
        Target(1).Comment.Visible = True
    End If
End Sub

ใน Worksheet ไม่มี Event การชี้เมาส์จึงไม่สามาถไปดัก Event การชี้เมาส์แล้วให้ทำงานตามต้องการ Code ด้านบนจะแสดง Comment เมื่อคลิกเซลล์ เซลล์ไหนไม่มีค่าก็ไม่แสดงภาพ

[modtanoi]

มีปัญหาเพิ่มเติมเรื่องการ Protect Sheet ไม่สามารถเปลี่ยนรูปได้ครับ
ได้ลองเปลี่ยนจากใช้ฟังก์ชั่นการ Protect Sheet ของ Excel มาเป็น Code(ด้านล่าง) ก็ไม่สามารถเปลี่ยนรูปได้ตามรายการครับ

Code: Select all

Sub MyMacro()
	Sheet1.Unprotect Password:="Secret"
		'YOUR CODE
	Sheet1.Protect Password:="Secret"
End Sub

[snasui]

ลองกำหนดให้เซลล์ที่ถูกเลือกยกเลิกการ Locked เซลล์ดูครับ

ตัวอย่างการ Locked, Unlocked เซลล์ดูที่นี่ครับ http://www.snasui.com/viewtopic.php?p=27301#p27301

[modtanoi]

ปัญหาใหม่ครับ ลองปรับสูตร Protect Sheet ไปเรื่อย(กำลังจะได้)
ลองปิดไฟล์แล้วเปิดใหม่กลับเจอข้อความแจ้งเตือนครับ

"Excel found unreadable content in '........................xlsm'. Doyou want to remove the content of this workbook? If you trust the source of this workbook, clik Yes."
'
'
'
'
"Removed Part: /xl/drawings/vmlDrawing1.vml part. (Drawing shape)"

Comment ที่สร้างไว้และปรับตำแหน่ง(อย่างเหนื่อย) หายหมดเลย เกิดอะไรขึ้นครับ?

[snasui]

ดูเหมือนจะยังไม่มีวิธีแก้สำหรับ Case นี้ สงสัยต้องสร้างใหม่ครับ

อ่านเพิ่มเติมจากที่นี่ครับ http://answers.microsoft.com/en-us/offi ... 6419d1f77c