هل يمكن إزالة كلمة المرور لمحرّر الأكواد

[عبد العزيز البسكري]

أستاذي القدير " ياسر العربي "

ما معنى ( الفيجوال بيسك ) .. هل معناها معمول  بالأكسس ؟؟

ألف شكر يا غالي على المجهود الطيّب و الجبّار .. تعبناك و الله

بارك الله فيك و جزاك الله خيرًا لما تقدّمه في تبسيط المعلومة للجميع دون استثناء

فقط لا تنساني ربنا يخليك و يعطيك ما تتمنّاه .. ولو بعد سنة إذا كنا من الأحياء ..لو فيه جديد أخبرني

فائق إحتراماتي لشخصك الكريم

[ياسر العربى]

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

انما انت حبيبي وهوضح ليك الحكاية

برنامج الفيجوال بيسك دا  يعتبر لغة برمجة من لغات كتيررررر جدا

vb6,c++,vb.net,As-sembly,c#,php,java,sql,oracel,

وفي غيرها كتيررر

المهم خلينا في الفيجوال بيسك 6

عارف انت محرر الاكواد بتاع الاكسيل اللي بنخش عليه ونعمل فورم ونحط تكست بوكس وزرار وليست بوكس وتعمل صفحة الويب بتاعتك دي وتعمل فيها النص المتحرك دا

المحرر دا بقي يعتبر جزء من الفيجوال بيسك مدمج مع مجموعةالاوفيس وهي

VBA

طبعا برنامج الفيجوال دا ممكن نعمل بيه اي برنامج  زي مثلا

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

وطبعا دا بيعمل ملفات تنفيذية يعني اي مشروع داخل البرنامج بنحوله لملف تنفيذي علي طول

 

[عبد العزيز البسكري]

17 دقائق مضت, ياسر العربى said:

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

انما انت حبيبي وهوضح ليك الحكاية

برنامج الفيجوال بيسك دا  يعتبر لغة برمجة من لغات كتيررررر جدا

vb6,c++,vb.net,As-sembly,c#,php,java,sql,oracel,

وفي غيرها كتيررر

المهم خلينا في الفيجوال بيسك 6

عارف انت محرر الاكواد بتاع الاكسيل اللي بنخش عليه ونعمل فورم ونحط تكست بوكس وزرار وليست بوكس وتعمل صفحة الويب بتاعتك دي وتعمل فيها النص المتحرك دا

المحرر دا بقي يعتبر جزء من الفيجوال بيسك مدمج مع مجموعةالاوفيس وهي

VBA

طبعا برنامج الفيجوال دا ممكن نعمل بيه اي برنامج  زي مثلا

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

وطبعا دا بيعمل ملفات تنفيذية يعني اي مشروع داخل البرنامج بنحوله لملف تنفيذي علي طول

 

[ياسر العربى]

واتفضل يامعلم البرنامج دا بالفيجوال

http://www.officena.net/ib/topic/64359-برنامج-بسيط-ربط-الفيجوال-بيسك-بالاكسيل-رائع-وتوفير-الحماية/

[عادل زكى]

لو سمحتم اساتذتى الكرام  يوجد العديد من ملفات الاكسل التى تستخدم فيها الاكواد نجدها محمية بكلمة مرور  فى بعض الاحيان نريد تغيير بعض الاشياء فى الاكواد بحيث تلائم الاحتياج فلا نستطيع فلو  ممكن حد  يخبرنى عن طريقة فك كلمة  سر   الاكواد اكون شاكر ولة منى كل تحية وتقديييييييييييييييييييير

[asdhamdey]

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Const WS_SYSMENU = &H80000
Private Sub hidesheet()
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1
Sheets(i).Visible = xlSheetVeryHidden
Next
End Sub

Private Sub alll()
For i = 1 To 5
Me.Controls("m" & i * 2).Visible = False
Me.Controls("a" & i).Top = 444
Me.Controls("x" & i).Top = 444
Next i
For i = 1 To 8
Me.Controls("c" & i).Top = 444
Next i
m2.Top = 555
m4.Top = 555
m2.Visible = True
m4.Visible = True
z1.Top = 444
z2.Top = 444
End Sub
Private Sub cha()
Call alll
Me.Height = 128
x1.Top = 68
x2.Top = 66
x3.Top = 88
x4.Top = 86
x5.Top = 78
End Sub
Private Sub cha1()
Call alll
Me.Height = 113
z1.Top = 64
z2.Top = 86
End Sub
Private Sub cha2()
MsgBox "  عذرا ... أنت لا تملك الصلاحية للدخول لهذه الصفحة ", 48, "BESSAFI"
End Sub
Private Sub pasn()
If Sheets(n3).ProtectContents = True Then Sheets(n3).Unprotect Password:=Sheet1.Range("d5").Value
Call hidesheet
Sheets(n3).Visible = xlSheetVisible
Sheets(n3).Select
End Sub
Private Sub pasy()
If Sheets(n3).ProtectContents = False Then Sheets(n3).Protect Password:=Sheet1.Range("d5").Value
Call hidesheet
Sheets(n3).Visible = xlSheetVisible
Sheets(n3).Select
End Sub
Private Sub a3_Click()
 Dim sht As Worksheet
For Each sht In ActiveWorkbook.Worksheets
If sht.Name = a2 Then
MsgBox "عذراً ... يوجد صفحة سابقة بهذا الاسم ...يرجى ادخال اسم اخر  ", 48, "hosami"
a2 = ""
Exit Sub
End If
Next sht
Me.Height = 27
dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1
Worksheets.add After:=Worksheets(dd)
Sheets(dd + 1).Name = a2.Value
Sheet1.Cells(7, (dd * 2) + 4) = a2.Value
Sheet1.Cells(8, (dd * 2) + 4) = a2.Value
a2 = ""
Sheet1.Select
Sheet1.ScrollArea = ""

Sheet1.Cells(10, (dd * 2) + 4).Select
MsgBox "عذراً ... يجب عليك إدخال صلاحيات المستخدمين لهذه الصفحة  ", 48, "hosami"
End Sub
Private Sub b4_Click()
Me.Height = 27
End Sub
Private Sub acess_set_Click()
Me.Height = 27
If acess_set.ForeColor = -2147483634 Then
Call hidesheet
Sheet1.Select
Sheet1.ScrollArea = ""
With ActiveWindow
.ScrollColumn = Range("a1").Column
.ScrollRow = Range("a1").Row
End With
Else
MsgBox "عذراً ... لا تملك الصلاحية لهذه العملية ", 48, "BESSAFI"
End If
End Sub
Private Sub b1_Click()
If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 16 Then
MsgBox "عذراً ...لقد وصلت للحد الاقصى لاضافة الصفحات ", 48, "hosami"

Exit Sub
End If
Call alll
Me.Height = 62
For i = 1 To 3
Me.Controls("b" & i).ForeColor = 65535
Next i
Me.Controls("b" & 1).ForeColor = 65280
a1.Top = 66
a2.Top = 65
a3.Top = 65
a4.Top = 81
Me.Height = 100
End Sub
Private Sub b2_Click()
If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 0 Then
MsgBox "عذراً ...البرنامج لا يحتوي على صفحات ", 48, "hosami"
Exit Sub
End If
Call alll
For i = 1 To 4
Me.Controls("b" & i).ForeColor = 65535
Me.Controls("m" & i * 2 + 2).Visible = True
Next i
Me.Controls("b" & 2).ForeColor = 65280
m4.Top = 60
dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7"))
Me.Height = (dd - 4) * 20 + 167
For i = 6 To 36 Step 2
Me.Controls("m" & i).Caption = Sheet1.Cells(7, i)
Me.Controls("m" & i).BackColor = 12648447
Next i

End Sub
Private Sub b3_Click()
If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 0 Then
MsgBox "عذراً ...البرنامج لا يحتوي على صفحات ", 48, "hosami"
Exit Sub
End If
Call alll
For i = 1 To 3
Me.Controls("b" & i).ForeColor = 65535
Next i
Me.Controls("b" & 3).ForeColor = 65280
m2.Top = 60
m6.Visible = True
m8.Visible = True
m10.Visible = True
dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7"))
Me.Height = (dd - 4) * 20 + 167
For i = 6 To 36 Step 2
Me.Controls("m" & i).Caption = Sheet1.Cells(7, i)
Me.Controls("m" & i).BackColor = 12648384
Next i
End Sub
Private Sub Label50_Click()
    ThisWorkbook.Close savechanges:=False
    End Sub

Private Sub Label51_Click()

 ActiveWorkbook.Save

End Sub

Private Sub Label52_Click()
If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 0 Then
MsgBox "عذراً ...البرنامج لا يحتوي على صفحات ", 48, "hosami"
Exit Sub
End If
Call alll
For i = 3 To (Application.WorksheetFunction.CountA(Sheet1.Range("f8:hh8")) * 2) + 3
Sheet1.Cells(2, i + 2) = Application.WorksheetFunction.VLookup(Sheet1.Range("c1").Value, Sheet1.Range("c10:hh5000"), i, 0)
Next i
dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7"))
Me.Height = (dd - 4) * 20 + 167
For i = 1 To 4
Me.Controls("m" & i * 2 + 2).Visible = True
Me.Controls("b" & i).Top = 555
Me.Controls("b" & i + 4).Top = 555
Next i
For i = 3 To 7
Me.Controls("c" & i).Top = 55
Me.Controls("c" & i + 1).Top = 56
Next i
Me.Controls("c" & 1).Top = 22
Me.Controls("c" & 2).Top = 30
Me.Controls("m" & 2).Visible = False
Me.Controls("m" & 4).Visible = False
Me.Controls("b" & 4).Top = 30
Me.Controls("b" & 4 + 4).Top = 48
For i = 6 To 36 Step 2
Me.Controls("m" & i).Caption = Sheet1.Cells(7, i)
Me.Controls("m" & i).BackColor = 12632256
If Sheet1.Cells(2, i) = "Yes" Then
Me.Controls("m" & i).BackColor = -2147483624
If Sheet1.Cells(2, i + 1) = "No" Then Me.Controls("m" & i).BackColor = 8421631
End If
Next i
End Sub
Private Sub m6_Click()
n2 = 6: n3 = 2
x2 = m6.Caption
z1 = m6.Caption
If m6.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m6.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m6.BackColor = 12632256 Then Call cha2
If m6.BackColor = -2147483624 Then Call pasn
If m6.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m8_Click()
n2 = 8: n3 = 3
x2 = m8.Caption
z1 = m8.Caption
If m8.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m8.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m8.BackColor = 12632256 Then Call cha2
If m8.BackColor = -2147483624 Then Call pasn
If m8.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m10_Click()
n2 = 10: n3 = 4
x2 = m10.Caption
z1 = m10.Caption
If m10.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m10.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m10.BackColor = 12632256 Then Call cha2
If m10.BackColor = -2147483624 Then Call pasn
If m10.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m12_Click()
n2 = 12: n3 = 5
x2 = m12.Caption
z1 = m12.Caption
If m12.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m12.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m12.BackColor = 12632256 Then Call cha2
If m12.BackColor = -2147483624 Then Call pasn
If m12.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m14_Click()
n2 = 14: n3 = 6
x2 = m14.Caption
z1 = m14.Caption
If m14.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m14.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m14.BackColor = 12632256 Then Call cha2
If m14.BackColor = -2147483624 Then Call pasn
If m14.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub

Private Sub m16_Click()
n2 = 16: n3 = 7
x2 = m16.Caption
z1 = m16.Caption
If m16.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m16.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m16.BackColor = 12632256 Then Call cha2
If m16.BackColor = -2147483624 Then Call pasn
If m16.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m18_Click()
n2 = 18: n3 = 8
x2 = m18.Caption
z1 = m18.Caption
If m18.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m18.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m18.BackColor = 12632256 Then Call cha2
If m18.BackColor = -2147483624 Then Call pasn
If m18.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m20_Click()
n2 = 20: n3 = 9
x2 = m20.Caption
z1 = m20.Caption
If m20.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m20.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m20.BackColor = 12632256 Then Call cha2
If m20.BackColor = -2147483624 Then Call pasn
If m20.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m22_Click()
n2 = 22: n3 = 10
x2 = m22.Caption
z1 = m22.Caption
If m22.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m22.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m22.BackColor = 12632256 Then Call cha2
If m22.BackColor = -2147483624 Then Call pasn
If m22.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m24_Click()
n2 = 24: n3 = 11
x2 = m24.Caption
z1 = m24.Caption
If m24.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m24.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m24.BackColor = 12632256 Then Call cha2
If m24.BackColor = -2147483624 Then Call pasn
If m24.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub

Private Sub m26_Click()
n2 = 26: n3 = 12
x2 = m26.Caption
z1 = m26.Caption
If m26.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m26.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m26.BackColor = 12632256 Then Call cha2
If m26.BackColor = -2147483624 Then Call pasn
If m26.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m28_Click()
n2 = 28: n3 = 13
x2 = m28.Caption
z1 = m28.Caption
If m28.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m28.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m28.BackColor = 12632256 Then Call cha2
If m28.BackColor = -2147483624 Then Call pasn
If m28.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m30_Click()
n2 = 30: n3 = 14
x2 = m30.Caption
z1 = m30.Caption
If m30.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m30.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m30.BackColor = 12632256 Then Call cha2
If m30.BackColor = -2147483624 Then Call pasn
If m30.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m32_Click()
n2 = 32: n3 = 15
x2 = m32.Caption
z1 = m32.Caption
If m32.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m32.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m32.BackColor = 12632256 Then Call cha2
If m32.BackColor = -2147483624 Then Call pasn
If m32.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m34_Click()
n2 = 34: n3 = 16
x2 = m34.Caption
z1 = m34.Caption
If m34.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m34.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m34.BackColor = 12632256 Then Call cha2
If m34.BackColor = -2147483624 Then Call pasn
If m34.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub
Private Sub m36_Click()
n2 = 36: n3 = 17
x2 = m36.Caption
z1 = m36.Caption
If m36.BackColor = 12648384 Then
Call cha
Exit Sub
End If
If m36.BackColor = 12648447 Then
Call cha1
Exit Sub
End If
If m36.BackColor = 12632256 Then Call cha2
If m36.BackColor = -2147483624 Then Call pasn
If m36.BackColor = 8421631 Then Call pasy
Me.Height = 27
End Sub

Private Sub pag_set_Click()

If pag_set.ForeColor = -2147483634 Then
Call alll
Me.Height = 62
For i = 1 To 4
Me.Controls("b" & i).ForeColor = 65535
Me.Controls("b" & i).Top = 30
Me.Controls("b" & i + 4).Top = 48
Next i
For i = 3 To (Application.WorksheetFunction.CountA(Sheet1.Range("f8:hh8")) * 2) + 3
Sheet1.Cells(2, i + 2) = Application.WorksheetFunction.VLookup(Sheet1.Range("c1").Value, Sheet1.Range("c10:hh5000"), i, 0)
Next i
Else
MsgBox "عذراً ... لا تملك الصلاحية لهذه العملية ", 48, "BESSAFI"
End If
End Sub
Private Sub UserForm_Activate()
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1
Sheets(i).Name = Sheet1.Cells(7, (i * 2) + 2)
Sheets(i).Visible = xlSheetVeryHidden
Next
If Sheet1.[e2] = "Yes" Then
acess_set.ForeColor = -2147483634
pag_set.ForeColor = -2147483634
Else
acess_set.ForeColor = 12632256
pag_set.ForeColor = 12632256
End If
End Sub
Private Sub UserForm_Initialize()
    Dim lngWindow As Long, lFrmHdl As Long
    lFrmHdl = FindWindow(vbNullString, Me.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
Me.Height = 27
End Sub
Private Sub x5_Click()
If x4 = "" Then Exit Sub
Sheets(n3).Name = x4.Value
Sheet1.Cells(7, n2) = x4.Text
Sheet1.Cells(8, n2) = x4.Text
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1
Sheets(i).Name = Sheet1.Cells(7, (i * 2) + 2)
Next
x4 = ""
Me.Height = 27
MsgBox " لقد تم تعديل إسم الصفحة بنجاح ", 48, "hosami"
End Sub
Private Sub z2_Click()
Sheets(n3).Visible = xlSheetVisible
Application.DisplayAlerts = False
Sheets(n3).Select
ActiveWindow.SelectedSheets.Delete
Sheet1.Select
Sheet1.Columns(n2 + 1).Delete
Sheet1.Columns(n2).Delete
Me.Height = 27
Sheet1.Select
Sheet1.ScrollArea = ""
With ActiveWindow
.ScrollColumn = Range("a1").Column
.ScrollRow = Range("a1").Row
End With
MsgBox " لقد تم إلغاء هذه الصفحة بنجاح ", 48, "hosami"
End Sub

في ٤‏/١٢‏/٢٠١٥ at 09:22, عبد العزيز البسكري said:

السّلام عليكم و رحمة الله و بركاته

ألف شكر أستاذي القدير " مختار حسين محمود " على الرّد السّار ..

بارك الله فيك .. جزاك الله خيرًا و زادها بميزان حسناتك و زادك من علمه و فضله

جمعة مباركة إن شاء الله

فائق إحتراماتي

كلمة المرور للسنة الأولى 1111

للسنة الثانية 2222

السنة الثالثة 3333 .. و هكذا

 

برنامج الاختبارات.rar

جزاك الله كل خير وبارك فيك

نريد شرح او كيفيه تطويع هذا الكود ليعمل في اي ملف

 

[asdhamdey]

اين المتغيرات التي ينبغي تغييرها لكي يعمل مع ملف اخر

جزاكم الله خيرا