沒殼的螃蟹 wrote:
謝謝,感覺真的很棒,...(恕刪)
學校一般都只教比較基礎的?!...我也不是學相關科系，不太清楚
沒殼的螃蟹 wrote:
對了,剛剛忘了問,你...(恕刪)
可以喔!請參考檔案[點擊下載]
我有發現你上方有查詢表單的功能，我想原本應該是要做一樣的事情吧?!我有修改了一下，你可以兩種方式都參考，如果有疑問可以站內信給我
小小尉 wrote:
可以喔!請參考檔案...(恕刪)
您真好心，幾乎改完了
，我就做不到，最多只會給個範例因為您圖形高度比較高，這2行要修改如下，調整一下圖形箭頭(尾巴)的位置
如果選的圖形沒箭頭(尾巴)，第2行可以省略
If Target.Top < 150 Then y = 5 Else y = Target.Top - 150
If y = 5 Then .Adjustments.Item(2) = Choose(Target.Row, 0, 0, 0, 0.055, 0.231, 0.399, 0.555, 0.695)
Adjustments 物件，請參考
https://docs.microsoft.com/zh-tw/office/vba/api/excel.adjustments
如果不介意趣味性太高
，也可以用圖形+msgbox代替輸入修改用，可省略一個表單10樓範例修改如下，請參考
'
'程式碼放在工作表1
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static h As Boolean
Static old_data As String
Static old_row As Integer
Dim Answer As Long
If h = True Then
If Worksheets("工作表1").Shapes("arrow").TextFrame.Characters.Text <> old_data Then
'If old_data = "error" Then MsgBox "No data to update"
'Debug.Print Worksheets("工作表1").Shapes("arrow").TextFrame.Characters.Text, old_data
Answer = MsgBox("Updating Data ???", vbOKCancel, "report")
Debug.Print Answer
If Answer = vbOK And old_data <> "error" Then
Worksheets("工作表2").Cells(old_row, 2).Value = Worksheets("工作表1").Shapes("arrow").TextFrame.Characters.Text
Else
'Debug.Print "cancel"
End If
End If
Worksheets("工作表1").Shapes("arrow").Delete
h = False
End If
On Error Resume Next
Dim check As Range, HighLight As Shape, Data As String, x As Integer, y As Integer
If Target.Column = 2 And Target.Interior.Color = vbRed And Target.Count = 1 Then
Set check = Worksheets("工作表2").Columns("a").Find(What:=Target.Value)
If check Is Nothing Then
Data = "error"
Else
Data = Worksheets("工作表2").Cells(check.Row, 2).Value
End If
old_data = Data
old_row = check.Row
x = Target.Left + 70
If Target.Top < 100 Then y = 5 Else y = Target.Top - 100
If Data <> "" Then
Set HighLight = Worksheets("工作表1").Shapes.AddShape(msoShapeCloudCallout, x, y, 260, 100)
h = True
With HighLight
.Fill.ForeColor.RGB = vbGreen
.TextFrame.Characters.Text = Data
.TextFrame.Characters.Font.Color = vbRed
.TextFrame.Characters.Font.Bold = msoTrue
.TextFrame.Characters.Font.Size = 24
.Adjustments.Item(1) = -0.55
If y = 5 Then .Adjustments.Item(2) = Choose(Target.Row, -0.419, -0.269, -0.119, 0.055, 0.199, 0.367, 0.523)
.Name = "arrow"
End With
End If
End If
Set check = Nothing
End Sub
內文搜尋
從 APP 打開
X