أكواد للمبتدئين

(f)الكود السادس والثمانون(f)

لاستخدام مساعد الأوفيس في برنامجك

قم بإدراج الأداة: Microsoft Agent control في مشروعك

ثم قم بإضافة الكود التالي:

Dim Genie As IAgentCtlCharacter

Private Sub Command1_Click()

Genie.Show

End Sub

Private Sub Command2_Click()

Genie.Hide

End Sub



Private Sub Command3_Click()

Genie.Play "Congratulate"

End Sub



Private Sub Command4_Click()

Genie.Play "Pleased"

End Sub



Private Sub Command5_Click()

Genie.Play "lookup"

End Sub



Private Sub Command6_Click()

 Genie.Play "Think"

End Sub



Private Sub Form_Load()

Dim Filename

Filename = "ضع مسار المساعد هنا وغالباً ما  يكون في المسار التالي  windowsmsagentchar"

' على سبيل المثال

' c:windowsmsagentchargenie.acs

Agent1.Characters.Load CharacterID:="Genie", LoadKey:=Filename

Set Genie = Agent1.Characters("Genie")

End Sub

agent.zip

شكرا لك أخي عبد الله فتحي على جهودك الرائعة .

ننتظر منك المزيد .

أخوك : سعد (f)

(f)الكود السابع والثمانون(f)

طريقة جميلة لإغلاق الفورم

Private Sub Form_Load()

Form1.Height = 7020

Form1.WindowState = 0

Timer1.Interval = 45



End Sub



Private Sub Timer1_Timer()

On Error Resume Next

Form1.Height = Form1.Height - 250

Timer2.Interval = 1500



End Sub



Private Sub Timer2_Timer()

End

End Sub

شكراً لك(f)

(f)الكود الثامن والثمانون(f)

أكواد نسخ قص لصق

Private Sub Command1_Click()

Clipboard.Clear

Clipboard.SetText text1

End Sub



Private Sub Command2_Click()

Clipboard.Clear

Clipboard.SetText text1

text1 =""

End Sub



Private Sub Command3_Click()

text1 = Clipboard.GetText

End Sub

(f)الكود التاسع والثمانون(f)

لحفظ ما يتغير في الـ Form حتى بعد إغلاقها

Private Sub Form_Load()

Text1.Text = GetSetting(App.Title, "Settings", "SaveInText1")

End Sub

Private Sub Form_Unload(Cancel As Integer)

SaveSetting App.Title, "Settings", "SaveInText1", Trim(Text1.Text)

End Sub

يمكنك تغيير ال text1 بأي شيء آخر image أو Picture أو ... الخ

(f)الكود التسعون(f)

لمعرفة رمز القرص ( هل هو قرص مرن ، صلب ، سيد دي .. الخ )

Private Declare Function GetDriveType Lib "kernel32" Alias 



"GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Command1_Click()



 Me.AutoRedraw = True

        Select Case GetDriveType(Text1.Text & ":")

        Case 2

            Form1.Caption = "قرص مرن"

        Case 3

              Form1.Caption = "قرص صلب"

        Case Is = 4

               Form1.Caption = "Remote"

        Case Is = 5

               Form1.Caption = "Cd-Rom"

        Case Is = 6

               Form1.Caption = "Ram disk"

        Case Else

               Form1.Caption = "غير معين"

    End Select

End Sub



Private Sub Form_Load()

Command1.Caption = "أدخل رمز القرص الذي تريد معرفته"

End Sub

driver.zip

(f)الكود الحادي والتسعون(f)

لتحويل حالة الأحرف من كبيرة إلى صغيرة والعكس

Private Sub Command1_Click()

x = Text1.Text

y = UCase(Left(x, Len(x)))

Text1.Text = y

End Sub

Private Sub Command2_Click()

x = Text1.Text

y = LCase(Left(x, Len(x)))

Text1.Text = y

End Sub

شكرا على هذه المشاركات وانا اايد هذا الموضوع

يعطيك الف الف عافية اخوي

بس حابة اغلبك معاي

بدي كود طباعة تقرير خاصة بقاعدة بيانات

وكود البحث خاصة بقاعدة البيانات

وذلك للضرورة

ومشكور على المجهود

الان هذا الكود الي بيحفظ التغييرات الفورم

وين بحفظ التغييرات في اي مللف؟

شكراً:)

يتم حفظ ما يتغير في البرنامج في المسار التالي ضمن الريجستري

HKEY_CURRENT_USERSoftwareVB and VBA Program SettingsX a c k e r

لاحظ ان X a c k e r

هو ال App.Title يعني اذا برنامجك اسمه FX

يكون المسار

HKEY_CURRENT_USERSoftwareVB and VBA Program SettingsXF

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

(f)(f)(f)(f)(f)(f)(f)(f)(f)(f)(f)

جزاك الله كل خير أخي (f)(f)

الأخوة الأكارم أعضاء المنتدى ... السلام عليكم ورحمة الله وبركاته:

في الحقيقة لا أجد الكلمات التي أستطيع أن أعبر بها عن مدى شكري لكم على تفاعلكم مع الموضوع سواء بالمشاركة أو التصويت... جزاكم الله خيراً ، وأتمنى أن أكون عند حسن ظنكم.

الأخوة المستقبل||| - BELAL SHARIF - بلال الكلح - المستحيل - KWITOWN - pROGRAMMER VBNET أهلا بكم ... وأتمنى لكم التوفيق.

الأخ CUTE FLOWER أشكرك على الثقة الغالية، وإن شاء الله سأشرح أوامر قواعد البيانات ولكن بعد الاختبارات.

تحية خاصة إلى الأخ والصديق العزيز (f)NOP(f) والحمد لله على السلامة ....

اذا كان في امكان اريد اخي ان تتكلم عن الdbcombo و ال dbgrid جزاك الله خيرا و خاصة في Version 6.0

بعد الامتحانات إن شاء الله(f)

متــــــــــــــــــــي تنتهي الامتحنات -----------> فأنا ايضا عندي امتحنات:mad::mad::mad::mad::mad::mad::mad::'(:'(:'(:'(:'(:'(:'(:'(:'(:'(:'(

ولكن بتوفيق والنجاح اخي عبد الله (f)(f)(f)(f)(f)(f)(f)(f)(f)(f)(f)(f)(f)(f)

تنتهي الامتحانات يوم 13/6/2003م (f)(f) أتمنى لك التوفيق والنجاح (f)(f)

(f)الكود الثاني والتسعون(f)

لتشغيل شاشة التوقف

Private Const SC_SCREENSAVE = &HF140&

Private Const WM_SYSCOMMAND = &H112

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long



Private Sub Command1_Click()

   Dim lState As Long

    If lHwnd = 0 Then

        lHwnd = FindWindowA(vbNullString, sFormCaption)

    End If

    If blnScreenSaver Then

        lState = 1

    Else

        lState = -1

    End If

    Call SendMessage(lHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, lState)

End Sub

(f)الكود الثالث والتسعون(f)

لمعرفة الوقت الذي مضى عل تشغيل الكمبيوتر

Private Declare Function StrFromTimeInterval Lib "shlwapi" Alias "StrFromTimeIntervalA" (ByVal pszOut As String, ByVal cchMax As Long, ByVal dwTimeMS As Long, ByVal dwDigits As Long) As Long

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Function GetFormattedTime(ByVal lTime As Long, Optional lDigits As Long = 4) As String



   Dim StrOut As String

   StrOut = Space(64)

   Call StrFromTimeInterval(StrOut, Len(StrOut) - 1, lTime, lDigits)

   GetFormattedTime = Trim(StrOut)

End Function



Private Sub Command1_Click()

   MsgBox "الكمبيوتر يعمل من " & GetFormattedTime(GetTickCount)

End Sub

(f)الكود الرابع والتسعون(f)

لإلغاء تفعيل زر الإغلاق في أعلى النافذة

ضع هذا الكود في الموديول

Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long 



Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long 



Public Const MF_BYPOSITION = &H400&

وهذا الكود في الفورم

Public Sub DisableCloseWindowButton(frm As Form) 



    Dim hSysMenu As Long 



    'Get the handle to this windows system menu 

    hSysMenu = GetSystemMenu(frm.hwnd, 0) 



    'Remove the Close menu item This will also disable the close button 

    RemoveMenu hSysMenu, 6, MF_BYPOSITION 



    'Lastly, we remove the seperator bar 

    RemoveMenu hSysMenu, 5, MF_BYPOSITION 



End Sub



Private Sub Form_Load() 

    DisableCloseWindowButton Me 

End Sub