كيفية تحريك الشخصية داخل اللعبة VB.net

بسم الله الرحمن الرحيم

سنقوم بعمل دروس بسيطة لانشاء لعبة بسيطة على الفيجوال بيسك دوت نت

ونبدأ بكيفية تحريك الشخصية داخل اللعبة في الاتجاهات الاربعة

كما تعلمنا سابقا نفتح مشروع جديد

ونتبع الشرح بالفيديو

الكود المستخدم داخل المشروع

  Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown

        Select Case e.KeyCode

            Case Keys.Up

                P1.Top -= 5

            Case Keys.Down

                P1.Top += 5

            Case Keys.Right

                P1.Left += 5

            Case Keys.Left

                P1.Left -= 5

        End Select

    End Sub

لتحميل السورس كود ع الرابط التالي

تحميل هنا
تحياتي
ياسر العربي

جمع القيم الموجبة والسالبة داخل عمود واحد باستخدام الدالة Sumif

مثال بسيط لاستخدام الدالة SUMIF عن طريق VBA

بسم الله الرحمن الرحيم

طلب احد الاخوة مثال للدالة SUMIF 

ولكن عن طريقة VBA

قمنا بعمل المثال التالي لتوضيح الفكرة

الكود المستخدم

 Sub Yasser_Test()  
   For x = 4 To 13  
     With Sheet2  
       Cells(x, 4) = Application.WorksheetFunction.SumIf(.Range("B4:B1000"), Cells(x, 2), .Range("D4:D1000"))  
       Cells(x, 5) = Application.WorksheetFunction.SumIf(.Range("B4:B1000"), Cells(x, 2), .Range("E4:E1000"))  
     End With  
   Next x  
 End Sub  

لتحميل الملف اضغط هنا

تحياتي

ياسر العربي

بعض طرق ترحيل البيانات - Data transfer

بسم الله الرحمن الرحيم

نقدم لكم اليوم بعض طرق ترحيل البيانات من شيت لاخر

الكود الاول

اول طريقة وهي عن طريق تخزين النطاق المراد ترحيله داخل مصفوفة 

ومن ثم وضعه في المكان المراد الترحيل اليه

كما موضح بالكود التالي

 Sub TRans()  
   Dim myArray() As Variant  
   myArray = Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row)  
   Sheet2.Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray  
   MsgBox "DONE....", 64  
 End Sub  

اما الكود الثاني

فهو يقوم بتحديد نطاق البيانات ومن ثم يقوم بالنسخ 

ويقوم بعمل لصق خاص (القيم فقط) اي البيانات بدون اي تنسيقات او 

معادلات

وتستطيع تغيير طريقة لصق البيانات كما بالصورة

منها لصق التنسيقات او لصق الجميع او لصق القيم الخ

الكود كما هو موضح 

 Sub TRans1()  
   Application.ScreenUpdating = False  
   Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row).Copy  
   Sheet2.Range("B" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial (xlPasteValues)  
   Application.CutCopyMode = False  
   Application.ScreenUpdating = True  
   MsgBox "DONE....", 64  
 End Sub  

الكود الثالث

يقوم بنسخ بطريقة الـ (Destination) 

ويتم وضع المكان الهدف المراد النسخ له بجانب كود النسخ مباشرة

وهذا الكود يقوم بنسخ البيانات كما هي بتنسيقاتها معادلاتها

كما موضح

 Sub TRans2()  
   Application.ScreenUpdating = False  
   Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row).Copy Sheet2.Range("B" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row + 1)  
   Application.ScreenUpdating = True  
   MsgBox "DONE....", 64  
 End Sub  

لتحميل المثال للثلاث طرق اضغط هنا

اعداد / ياسر العربي

فصل القيم النصية والرقمية Split Text & Number

بسم الله الرحمن الرحيم

اقدم لكم دالة معرفة لفصل القيم النصية عن القيم الرقمية

كل ما علينا هو ان نضيف هذ الكود للدالة المعرفة بموديل كما بالصورة

كود الدالة

 Public Function SplitText(WorkRng As Range, Number As Boolean) As String  
   Dim xLen As Long  
   Dim xStr As String  
   xLen = VBA.Len(WorkRng.Value)  
   For i = 1 To xLen  
     xStr = VBA.Mid(WorkRng.Value, i, 1)  
     If ((VBA.IsNumeric(xStr) And Number) Or (Not (VBA.IsNumeric(xStr)) And Not (Number))) Then  
       SplitText = SplitText + xStr  
     End If  
   Next  
 End Function  

طريقة كتابة الدالة


للقيم النصية
  =SplitText($A2;0)
 أو
=SplitText($A2;False)

للقيم الرقمية
=SplitText($A2;1)
أو
=SplitText($A2;TRUE)

كود اخر لفصل كل قيمة على حدا

الكود المستخدم للقيمتين

 Sub split_Text()  
   Dim xLen As Long  
   Dim xStr As String  
   Dim Rng As Range  
   For Each Rng In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)  
     xLen = VBA.Len(Rng.Value)  
     Rng.Offset(, 4).ClearContents  
     For i = 1 To xLen  
       xStr = VBA.Mid(Rng.Value, i, 1)  
       If Not (VBA.IsNumeric(xStr)) And Not (Number) Then  
         Rng.Offset(, 4) = Rng.Offset(, 4) + xStr  
       End If  
     Next i  
   Next Rng  
 End Sub  
 Sub Split_NUM()  
   Dim xLen As Long  
   Dim xStr As String  
   Dim Rng As Range  
   For Each Rng In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)  
     xLen = VBA.Len(Rng.Value)  
     Rng.Offset(, 5).ClearContents  
     For i = 1 To xLen  
       xStr = VBA.Mid(Rng.Value, i, 1)  
       If (VBA.IsNumeric(xStr)) And Not (Number) Then  
         Rng.Offset(, 5) = Rng.Offset(, 5) & xStr  
       End If  
     Next i  
   Next Rng  
 End Sub
  

لتحميل الملف اضغط هنا

ياسر العربي

عرض الاكواد داخل المدونة داخل اطار بطريقة منظمة

بسم الله الرحمن الرحيم

اقدم لكم اليوم برنامج صغير وبسيط يخدم كل اصحاب المواقع والمدونات عند ادراج الاكواد داخل المواضيع او الصفحات

ويعمل على الاكواد بشكل عام لاى لغة برمجة 

يتم ادراج الكود داخل البرنامج وتحويله ومن ثم نسخه ووضعه داخل الصفحة في وضع HTML

صورة البرنامج

احد الاكواد بعد التنسيق

 Private Sub TextBox1_Change()  
   Dim myArray, lr, X, targt, targtN  
   Dim DATA As Worksheet  
   Set DATA = Worksheets("Sheet2")     
   lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row    
   ListBox1.Clear   
   targt = TextBox1.Text   
   targtN = ComboBox1.ListIndex + 1    
   myArray = DATA.Range("A2:J" & lr)     
   ReDim y(1 To UBound(myArray, 1), 1 To UBound(myArray, 2))  
   For X = LBound(myArray) To UBound(myArray)  
     If targt = "" Then Exit Sub  
     If myArray(X, targtN) Like targt & "*" Then  
       rw = rw + 1  
       For yy = 1 To 10  
         y(rw, yy) = myArray(X, yy)  
       Next yy  
     End If  
   Next X  
   If rw > 0 Then  
     ListBox1.AddItem  
     ListBox1.List = y()  
   End If  
 End Sub  

لتحميل البرنامج اضغط هنا


اعداد / ياسر العربي

عرض صورة المنتج ومعلوماته داخل اليوزر فورم

بسم الله الرحمن الرحيم

سابقا كنت تبحث عن طريقة تعرض بها منتجا علي الاكسيل بمعلومات 

كاملة عنه وهي بيانات المنتج وصورته فكان من السهل الوصول للبيانات 

 بمعادلات بسيطة وسهلة اما صورة المنتج فكانت هذه هي مشكلة بعض 

المستخدمين . فيفقد الملف جزء مهم وهو الصورة التوضيحية للمنتج

فاحببت ان افيدكم بكود كنت قد نشرته منذ فترة واعدت نشره مره اخرى

لان المعظم سيحتاجه لاكثر من استخدام

اليكم صورة  المثال 

لتحميل الملف اضغط هنا

اعداد / ياسر العربي