مجموعة من كود vba

[smail_d]

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

جرب الكود

Option Explicit
' اعرض هذه الرسالة عن الحسابات

Sub CalculMentalV1()
  MsgBox "اهلا بك في برنامج الحساب"
  MsgBox "شكرا جزيلا للمرة الثانية"
End Sub[/php]

[smail_d]

Sub CalculMentalV1()
  MsgBox "اهلا بك في برنامج الحساب"
  MsgBox "شكرا جزيلا للمرة الثانية"
End Sub[/php]

[smail_d]

Sub CalculMentalV1()

End Sub

MsgBox "اهلا بك في برنامج الحساب"

MsgBox "شكرا جزيلا للمرة الثانية"

End Sub

[smail_d]

Sub CalculMentalV1()
  MsgBox "اهلا بك في برنامج الحساب"
  MsgBox "شكرا جزيلا للمرة الثانية"
End Sub
[/php]

[smail_d]

Sub CalculMentalV1()
  MsgBox "اهلا بك في برنامج الحساب"
  MsgBox "شكرا جزيلا للمرة الثانية"
End Sub

[smail_d]

الحمد لله يارب

[smail_d]

الكود الثاني

Sub CalculMentalV4()
  Dim N1
  Randomize
  MsgBox "اهلا بك في برنامج الحساب"
  N1 = Int((100 * Rnd) + 1)
  MsgBox N1
  MsgBox "شكرا "
End Sub

[smail_d]

Sub CalculMentalV5()
  Dim N1, N2
  Randomize
  MsgBox "برنامج الحساب"
  N1 = Int((100 * Rnd) + 1)
  N2 = Int((100 * Rnd) + 1)
  MsgBox "N1 égale " & N1
  MsgBox "N2 égale " & N2
  MsgBox "شكر نواصل معا"
End Sub

[smail_d]

الكود المالي

عملية الجمع

تستطيع استعمال زر للعملية

Sub CalculMentalV7()
  Dim N1, N2
  Dim Reponse ' Stockage de la réponse de l'utilisateur
  Randomize
  MsgBox "اهلا بك في برنامج الحساب عملية الجمع"
  N1 = Int((100 * Rnd) + 1)
  N2 = Int((100 * Rnd) + 1)
  Reponse = InputBox("كم تساوي لو جمعنا " & N1 & " + " & N2 & " ?")
  If Reponse = N1 + N2 Then
    MsgBox "اجابة صحيحة هائل !"
  Else
    MsgBox "اجابة خاطئة ... الاجابة الصحيحة هي " & N1 + N2
  End If
  MsgBox "شكرا في المرة اللاحقة"
End Sub

[smail_d]

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

الكود التالي "عمليات حسابية "

Sub CalculMentalV9()

  Dim N1 As Integer
  Dim N2 As Integer

  Dim Reponse
  Randomize
  MsgBox "عمليات حسابية"

  ' حساب :
  N1 = Int((100 * Rnd) + 1)
  N2 = Int((100 * Rnd) + 1)
  Reponse = InputBox("احسب القيمة التالية " & N1 & " + " & N2 & " ?")
  If Reponse = N1 + N2 Then
    MsgBox "اجابة صحيحة !"
  Else
    MsgBox "اجابة خاطئة ... الاجابة الصحيحة هي " & N1 + N2
  End If

  ' المثال الثاني :
  N1 = Int((100 * Rnd) + 1)
  N2 = Int((100 * Rnd) + 1)
  Reponse = InputBox("كم تساوي " & N1 & " + " & N2 & " ?")
  If Reponse = N1 + N2 Then
    MsgBox "اجابة صحيحة خيالي !"
  Else
    MsgBox "اجابة خاطئة ... الاجابة الصحيحة هي " & N1 + N2
  End If

  ' ثالث مثال :
  N1 = Int((100 * Rnd) + 1)
  N2 = Int((100 * Rnd) + 1)
  Reponse = InputBox("احسب التالي " & N1 & " + " & N2 & " ?")
  If Reponse = N1 + N2 Then
    MsgBox "اجابة صحيحة انت لك مستقبل زاهر في الاكسل !"
  Else
    MsgBox "اجابة خاطئة ... الاجابة الصحيحة هي " & N1 + N2
  End If

  'رابع مثال :
  N1 = Int((100 * Rnd) + 1)
  N2 = Int((100 * Rnd) + 1)
  Reponse = InputBox("احسب مايلي " & N1 & " + " & N2 & " ?")
  If Reponse = N1 + N2 Then
    MsgBox "اجابة صحيحة بارع !"
  Else
    MsgBox "اجابة خاطئة ... الاجابة الصحيحة هي " & N1 + N2
  End If

  MsgBox "شكرا لك تحياتنا في منتدى أوفسينا"
End Sub

[فلسطيني]

شكرا أخي على هذا الجهد الطيب و أتمنى ان نستفيد جميعا بما جمعته لنا و نوظفه في تطبيقات جديدة مفيدة .

[smail_d]

الكتابة في الخلايا

Sub Test()
  Cells(4, 2) = "بسم الله الرحمن الرحيم"
End Sub
[/php]

[smail_d]

الكتابة في الخلية

Sub Test()
  Cells(4, 2) = "بسم الله الرحمن الرحيم"
End Sub

[smail_d]

تكرار الكلمة في الاعمدة

Sub Test()
  Dim Ctr As Integer
  For Ctr = 1 To 10
    Cells(Ctr, 1) = "ca marche"
  Next 
End Sub

[smail_d]

تكرار الجملة في المجال

Sub Test()
  Dim Ctr As Integer
Range("A5:A10") = "بسم الله الرحمن الرحيم"
End Sub

[smail_d]

كتابة كلمة او جملة في المجال و رقم الصف

Sub Test()
  Dim Ctr As Integer
Range("A5:A10")(1) = "Trois"
End Sub

[smail_d]

ترقيم المجال بالتسلسل

Sub test()
  For Ctr = 1 To 5
    Range("A5:A10")(Ctr) = Ctr
  Next
End Sub

[محمودعبدالعزيز]

اخي العزيز ممكن لو تكرمت تشرح كيفية الاستفادة من هذة الجمل

اعني كيفية وضعها في الاكسيل , و تنفيذها ,,

ارجو المساعدة ,

[smail_d]

يتبع

هذا الكود يعطي لك كل حرف على حدى في الجملة

Sub CompteVoyelle()
  Dim Phrase As String
  Phrase = "بسم الله الرحمن الرحيم"
  For Compteur = 1 To Len(Phrase)
    MsgBox Mid(Phrase, Compteur, 1)
  Next
End Sub

[هادى محمد المامون سالم]

مشكور اخى على المعلومات المفيده

[smail_d]

حذف الاطار الخارجير للاكسيل أي تكبير

Sub AnsichtGanzerBildschirm()
  Application.DisplayFullScreen = True
End Sub

[فلسطيني]

أخي الكريم شكرا جدا على هذه الروائع التي تذكرنا بروائع أخينا عمر الحسيني الذي اشتقنا لروائعه .

[smail_d]

نقل محتوى الخلايا بما فيها الى خلايا اخري

Sub PLzTrennen()
Range("d2").Select
Do Until ActiveCell.Value = ""
 ActiveCell.Offset(0, -3).Value = Left(ActiveCell.Value, 5)
 ActiveCell.Value = Mid(ActiveCell.Value, 7, 100)
 ActiveCell.Offset(1, 0).Select
Loop
End Sub

[smail_d]

الكتابة في أحدى الخلايا عن طريق الرسالة

Sub EingabeUeberInputbox()
Dim wert01 As String
    wert01 = InputBox("ماذا تريد أن تكتب فيى الخلية ", "لا تريد الكتابة ")
    Range("a1").Value = wert01
End Sub

[smail_d]

تلوين الخلية عند تحديدها بأحد الألوان

Option Explicit


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Static OldCell As Range

If Not OldCell Is Nothing Then
    OldCell.Interior.ColorIndex = xlColorIndexNone
End If

Target.Interior.ColorIndex = 5

Set OldCell = Target

End Sub