تلميحات سريعة في الكود

هذه طريقة تأجيل تنفيذ الكود لفترة معينة

ضع في الوحدة النمطية الخاصة بالنموذج الكود التالي

Public Sub Delay(HowLong As Date)
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents
Wend
End Sub
***********************

وضع في حدث ( عند النقر ) للزر الكود التالي

Delay 5
MsgBox " الفريق العربي للبرمجة ... منتدى قواعد البيانات مايكروسوفت"

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

لجعل مؤشر الماوس لا يخرج من حدود الفورم ،اليكم الكود .

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

لأسر مؤشر الفأره داخل حدود الفورم اليكم بالتالي :

ضع الكود التالي داخل مديول :

Type RECT 
Left As Long 
Top As Long 
Right As Long 
Bottom As Long 
End Type 
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long 

ثم ضع الكود التالي في الفورم : 

Private Sub Form_Load() 
'The form should not be set to sizable or this will not work. You should also call the code each time the user moves the form. 
Dim lngX As Long 
Dim lngY As Long 
Dim lngReturn As Long 
Dim NewRect As RECT 

'Get the screens Twips per pixel (form's scalemode must be Twips) 
lngX = Screen.TwipsPerPixelX 
lngY = Screen.TwipsPerPixelY 

'Set cursor region to that of form 
With NewRect 
.Left = Me.Left / lngX 
.Top = Me.Top / lngY 
.Right = .Left + Me.Width / lngX 
.Bottom = .Top + Me.Height / lngY 
End With 
lngReturn = ClipCursor(NewRect) 
End Sub

لتغيير لون الخط في مربع النص ما عليك إلا كتابة الكود

Text1.ForeColor = 255
مع تغيير الرقم 255 إلى رقم اللون الذي تريد 
255 هو اللون الأحمر

لكي تلغي الرسائل التحذيرية عند تنفيذ استعلام معين عن طريق الكود

DoCmd.SetWarnings False

ولإعادة الرسائل التحذيرية

DoCmd.SetWarnings True

ومن الافضل ان تضع الكود الاول عند انطلاق الكود وفي نهايته بالضبط ضع الكود الثاني

مثال

Private Sub a1_Click()
DoCmd.SetWarnings False
DoCmd.OpenQuery "aa"
DoCmd.SetWarnings True
End Sub

لنفرض ان الحقل لديك اسمه a لكي تجعله غير ممكن ضع هذا الكود تحت زر امر او عند فتح الفورم او حدث تريد

a.Enabled = False

وهذا للسماح بالتمكين

a.Enabled = True

وهذا الكود لجعل الحقل مقفل فلا تستطيع الكتابة فيه

a.Locked = True

وهذا لإلغاء القفل

a.Locked = False

وهذا الكود لإخفاء الحقل

a.Visible = False

وهذا الكود لإظهاره

a.Visible = True

لجعل المؤشر ينتقل الى الحقل a

a.SetFocus

للتحكم في ارتفاع وعرض الحقل

a.Height = 700
a.Width = 1000

للتحكم في حجم الخط

a.FontSize = 15

اخوكم/ المبرمج2003

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

ارجو ان تستمعوا بها ;) ;)

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

اللي عنده استفسار يراسلنا على الخاص وانا حاضر

(h) (h) (h) (h) (h)

لنقل الملفات مثلا الملف الاكسل من ال C إلى D

Name "c:\02.xls" As "D:\02.xls"

لنسخ الملفات وهنا على نفس القرص

FileCopy "C:\a.txt", " C:\a1.txt"

لمعرفة حجم الملف طبعا بالبايت و الكيلو بايت

Dim MySize
MySize = FileLen("c:\aa.TXT")
MsgBox MySize & " الحجم بالبايت"
MsgBox (MySize / 1024) & " الحجم بالكيلوبايت "

لحذف ملف بعد ان تأذن له

If MsgBox("هل تريد حذف هذا الملف ", _
    vbInformation + vbYesNo + vbDefaultButton2, _
    "تنبيه") = vbYes Then
 Kill ("C:\012.xls")
End If

لحساب عدد الحروف داخل الحقل aa

MsgBox ("عدد الحروف = " + Str(Len(aa)))

تكبير الحروف طبعا ضع زر امر وحط هذا الكود تحته لكي يقوم بتكبير الحرف إلى كبتل

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

وكذلك ضع زر امر هنا وضع هذا الكود تحته لكي تقوم بتصغير الحروف إلى سمول

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

لا تنسى ان تضع اسم الحقل Text1

:) :) :)

وشكرا للجميع

(h)

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

أساتذتي الكرام :

أحسن الله إليكم ووفّقكم لكل خير وأجزل لكم المثوبة 0

لعكس الحروف

ظع مربعين نص

الاول = aa

الثاني = aaa

وزرين امر

زر الامر الاول

Public Function reversestring(revstr As String) As String
Dim doreverse As Long
reversestring = ""
For doreverse = Len(revstr) To 1 Step -1
reversestring = reversestring & Mid$(revstr, doreverse, 1)
Next
End Function

زر الاتمر الثاني

Private Sub Command_Click()
Dim strResult As String
strResult = reversestring(aa)
aaa = strResult
End Sub

لا يسمح إلا بكتابة ارقام في الحقل <_< <_< <_<

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub

لا يسمح بالمسافة داخل الحقل :( :( :(

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Then
        KeyAscii = 0
    End If
End Sub

اخفاء الفارة وعودتها :D :D :D

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Sub Command1_Click()
X = ShowCursor(False)
End Sub

Private Sub Command2_Click()
X = ShowCursor(True)
End Sub

لظهور رسالة عند الضغط بالزر الايمن ضع في حدث عند الضغط على الماوس

If Button = 2 Then
MsgBox "الزر الأيمن للماوس"
End If

لافراغ سلة المحذوفات (المهملات)

لإفراغ سلة المحذوفات :wacko: :wacko: :wacko:

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long

Private Sub Command1_Click()
SHEmptyRecycleBin Me.hwnd, vbNullString, 0
SHUpdateRecycleBinIcon
End Sub

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

'استخدم المكتبة  Microsoft Scripting Runtime
Private Sub Command1_Click()
 Dim obj_FSO As Object, obj_Drive As Object
 Set obj_FSO = CreateObject("Scripting.FileSystemObject")
 Set obj_Drive = obj_FSO.GetDrive("c:\")
 MsgBox obj_Drive.SerialNumber
 Set obj_FSO = Nothing
 Set obj_Drive = Nothing
End Sub

'للتحكم في رفع الصوت وخفضه اذا حاب تسمع حاجة :D :D :D

Private Declare Function waveOutSetVolume Lib "Winmm.dll" (ByVal DevID As Integer, ByVal Vol As Long) As Long

Sub SetVol(Volume As Long)
Dim Vol&
Vol = CLng("&H" & Hex(Volume + 65536))
waveOutSetVolume 0, Vol
End Sub

Private Sub Command1_Click()
SetVol Text1
End Sub

Private Sub Form_Load()
Text1 = "ضع قيمة بين 0 و 65536"
End Sub

ان شاء الله ترون المزيد

مع تحيات اخوكم المبرمج2003