وعليكم السلام أخي الكريم محمود عبد الشافي
أهلاً بك في المنتدى ونورت بين إخوانك
الموضوع ينقصه الكثير من التفاصيل ولا يوجد ملف مرفق للعمل عليه ، وأنا عادةً لا أشارك في الموضوع بهذا الشكل ولكن سأعتبر هذا استثناء لأنك عضو جديد بالمنتدى
وسأضع فرضيات بحيث تفهم كيف يتم التعامل مع الكود وكيف تطوعه ليتناسب مع ملفك
بفرض أن لديك ورقة عمل اسمها البرمجي Sheet1 (والاسم البرمجي غير الاسم الظاهر في تبويبات أوراق العمل) ، ولديك نطاق البيانات يبدأ من الخلية A1 وينتهي في العمود الخامس العمود E ، وبفرض أن لديك صف عناوين وهو الصف الأول ، والمطلوب أن ترسم خط بعد صف العناوين أي بدايةً من الصف الثاني وتحديداً الخلية A2 ويمكنك تغيير خلية البداية في الكود
أولاً ضع الكود التالي في موديول عادي (اضغط على Alt + F11) للدخول لمحرر الأكواد ثم من قائمة Insert اختر Module والصق الكود التالي
Sub DrawLineBetweenCells(ByVal r1 As Range, ByVal r2 As Range)
Dim ws As Worksheet, shp As Shape, x1 As Single, y1 As Single, x2 As Single, y2 As Single
Set ws = r1.Parent
x1 = r1.Left
y1 = r1.Top
x2 = r2.Left + r2.Width
y2 = r2.Top + r1.Height
Set shp = ws.Shapes.AddLine(x1, y1, x2, y2)
With shp
.Name = "MyLine"
With .Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 1.25
.EndArrowheadStyle = msoArrowheadNone
.DashStyle = msoLineSolid
End With
End With
End Sub
والكود السابق هو إجراء عام أي لا يمكن تنفيذه بشكل مباشر ولكن يلزم أن تنفذه من إجراء آخر كما سنرى لأنك ستحدد بارامترات لهذا الإجراء العام
وهو ببساطة يقوم برسم خط من خلية إلى خلية أخرى ، ويمكن في هذا الإجراء العام التحكم في لون الخط وسمك الخط وشكل الخط كما يقوم الكود بتسمية الخط باسم معين لأنه سيتعين حذف هذا الخط في كل مرة ستقوم بإضافة بيانات جديدة في ورقة العمل
ثانياً ضع الكود التالي في حدث ورقة العمل Sheet1 (كليك يمين على اسم ورقة العمل ثم اختر View Code) ثم الصق الكود التالي
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r1 As Range, r2 As Range
If Target.Cells.CountLarge > 1 Then Exit Sub
If Target.Column = 1 And Target.Row > 1 Then
With Sheet1
On Error Resume Next
.Shapes("MyLine").Delete
On Error GoTo 0
Set r1 = .Range("A2")
Set r2 = .Range("E" & .Cells(Rows.Count, 1).End(xlUp).Row + 1)
End With
DrawLineBetweenCells r1, r2
End If
End Sub
نلاحظ أن الكود في حدث التغير في ورقة العمل بحيث عند إضافة أي بيانات جديدة في ورقة العمل في العمود الأول سيتم تنفيذ أسطر الكود
والكود يمكنك من تحديد نقطة البداية أو خلية البداية من خلال المتغير r1 أما نقطة أو خلية النهاية ستكون مرتبطة بآخر صف به بيانات مضاف إليه واحد ليتعامل مع أول صف فارغ وهنا وضعنا الرمز E لأن البيانات كفرضية تنتهي في العمود E فيقوم الكود برسم خط من خلية البداية إلى خلية النهاية
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
