اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information