اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الشكل يتبعك حيث ما كنت داخل الشيت


الردود الموصى بها

السلام عليكم

الاستاذ الحبيب ابو حنين حفظك الله

اعجبني هذا العمل جزاك الله كل خير

واحببت أن اضيف اضافة بسيطه وهذا بعد اذنك

أن الشكل ينشاء اتومتيك

هذه الأكواد في مودويل


Public Sh_A   As Shape

Sub Ali_Add()

Dim A

Dim B

Dim C

Set A = ThisWorkbook.VBProject

Set C = A.VBComponents.Item("My_C").CodeModule

C.AddFromString ("Sub Sh_Addres" & vbCrLf & "dim S$" & vbCrLf & "S = ""Ali_Sh"" " & vbCrLf & "Set Sh_A = ActiveSheet.Shapes(S)" & vbCrLf _

& "MsgBox ""  أنا الآن في الصف رقم : "" & Sh_A.TopLeftCell.Row & ""  العمود رقم  :  "" & activeCell.Column " & vbCrLf _

& " set Sh_A = nothing " & vbCrLf & "End Sub")

End Sub

Sub Ali_M()

Set V_A = ActiveWorkbook.VBProject

Set V_b = V_A.VBComponents.Add(vbext_ct_StdModule)

V_b.Name = "My_C"

End Sub

Sub Ali_Delet()

On Error Resume Next

Dim V_A

Dim V_b

Set V_A = ActiveWorkbook.VBProject

Set V_b = V_A.VBComponents("My_C")

ActiveWorkbook.VBProject.VBComponents.Remove V_b

End Sub

وهذا كودك وعليه تعديل بسيط " كود حدث الورقة "

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

With Target

With ActiveSheet

On Error Resume Next

  .Shapes("Ali_Sh").Delete

End With

Set Sh_A = ورقة1.Shapes.AddShape(msoShapeActionButtonend, .Left, .Top, .Width, .Height)

With Sh_A

  .TextFrame.HorizontalAlignment = xlHAlignCenter

  .TextFrame2.TextRange.Text = "أين موقعي"

  .Name = "Ali_Sh"

MsgBox " الصف :" & .TopLeftCell.Row & " العمود :" & Target.Column

Call Ali_Delet

Call Ali_M

Call Ali_Add

.OnAction = "Sh_Addres"

End With

End With

Cancel = True

End Sub

تحديد موقع_A.rar

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information