talaldc

Atheer Al Attar شكراً لك ولاكن أخوك في الانجليزي شوية مو جيد ياليت تشرح بالعربي

السلام عليكم ورحمة الله أخي Atheer Al Attar هل من الممكن أن تشرح لي كيفية جعل البيانات في الخلاياء Number كي تختفي مشكلة الاعتراض على الخليه الفارغة

نعم نعم وأنا اعاني من نفس المشكلة فما الحل هل هناك طريقة تجعل من الاكسل يكون فعال جداً

السلام عليكم ورحمة الله وبركاته سؤال يا زملائي هو كيف اجعل جميع الخلاياء في شت يكون العدد فيها صفر لانه في بعض الاحيان عندما ارحل بيانات موظف وهو يتكون من عددة خلاياء يتم لها جمع فعندما يتم الجمع لجميع الخلاياء وتكون احداها خاليه من العدد لا يظهر لي الناتج وانا رسالة بان المعادلة خاطئة حتى اضع في الخلية الفارغة صفر فتشتغل المعادلة ؟؟؟؟ شكراً لكم مع تمنياتي لكم بدوام الصحة و العافية

أهلاً وسهلاً أخي أبو اسامة أشكر تعاونك وبأنتظارك ودمت سالماً

السلام عليكم ورحمة الله وبركاته أتمنى الاطلاع على المرفق كون فيه شرح للفكرة التي تجول في عقلي ولك جزيل الشكر _______________.rar

شكراً وفقك الله

ضع هدا الكود في الفورم Const FTP_TRANSFER_TYPE_UNKNOWN = &H0 Const FTP_TRANSFER_TYPE_ASCII = &H1 Const FTP_TRANSFER_TYPE_BINARY = &H2 Const INTERNET_DEFAULT_FTP_PORT = 21 ' default 'for FTP servers Const INTERNET_SERVICE_FTP = 1 Const INTERNET_FLAG_PASSIVE = &H8000000 ' used 'for FTP connections Const INTERNET_OPEN_TYPE_PRECONFIG = 0 ' 'use registry configuration Const INTERNET_OPEN_TYPE_DIRECT = 1 ' 'direct to net Const INTERNET_OPEN_TYPE_PROXY = 3 ' 'via named proxy Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 ' prevent using java//INS Const MAX_PATH = 260 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lCon As Long) As Long Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwCon As Long) As Boolean Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwCon As Long) As Boolean Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dw As Long) As Long Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long Const PassiveConnection As Boolean = True Private Sub Form_Load() Dim hConnection As Long, hOpen As Long, sOrgPath As String 'open an internet connection hOpen = InternetOpen("API-Guide sample program", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0) 'connect to the FTP server hConnection = InternetConnect(hOpen, "your ftp server", INTERNET_DEFAULT_FTP_PORT, "your login", "your password", INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0) 'create a buffer to store the original directory sOrgPath = String(MAX_PATH, 0) 'get the directory FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath) 'create a new directory 'testing' FtpCreateDirectory hConnection, "testing" 'set the current directory to 'root/testing' FtpSetCurrentDirectory hConnection, "testing" 'upload the file 'test.htm' FtpPutFile hConnection, "C:\test.htm", "test.htm", FTP_TRANSFER_TYPE_UNKNOWN, 0 'rename 'test.htm' to 'apiguide.htm' FtpRenameFile hConnection, "test.htm", "apiguide.htm" 'enumerate the file list from the current directory ('root/testing') EnumFiles hConnection 'retrieve the file from the FTP server FtpGetFile hConnection, "apiguide.htm", "c:\apiguide.htm", False, 0, FTP_TRANSFER_TYPE_UNKNOWN, 0 'delete the file from the FTP server FtpDeleteFile hConnection, "apiguide.htm" 'set the current directory back to the root FtpSetCurrentDirectory hConnection, sOrgPath 'remove the direcrtory 'testing' FtpRemoveDirectory hConnection, "testing" 'close the FTP connection InternetCloseHandle hConnection 'close the internet connection InternetCloseHandle hOpen End Sub Public Sub EnumFiles(hConnection As Long) Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long 'set the graphics mode to persistent Me.AutoRedraw = True 'create a buffer pData.cFileName = String(MAX_PATH, 0) 'find the first file hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0) 'if there's no file, then exit sub If hFind = 0 Then Exit Sub 'show the filename Me.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1) Do 'create a buffer pData.cFileName = String(MAX_PATH, 0) 'find the next file lRet = InternetFindNextFile(hFind, pData) 'if there's no next file, exit do If lRet = 0 Then Exit Do 'show the filename Me.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1) Loop 'close the search handle InternetCloseHandle hFind End Sub Sub ShowError() Dim lErr As Long, sErr As String, lenBuf As Long 'get the required buffer size InternetGetLastResponseInfo lErr, sErr, lenBuf 'create a buffer sErr = String(lenBuf, 0) 'retrieve the last respons info InternetGetLastResponseInfo lErr, sErr, lenBuf 'show the last response info MsgBox "Error " + CStr(lErr) + ": " + sErr, vbOKOnly + vbCritical End Sub فتح صفحة انترنت ضع هدا الكود في الفورم Private Sub Command1_Click() l "RUNDLL32.EXE URL.DLL,FileProtocolHandler http://www.al-ebda3.info/ib/", vbNormalFocus End Sub Private Sub Command2_Click() Dim X As Object Set X = CreateObject("InternetExplorer.Application") X.Navigate "www.noisrael.com" X.Visible = True End Sub حالة الاتصال بالانترنت ضع هدا الكود في الموديول Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long Public Const RAS95_MaxEntryName = 256 Public Const RAS95_MaxDeviceType = 16 Public Const RAS95_MaxDeviceName = 32 Public Type RASCONN95 dwSize As Long hRasCon As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Public Type RASCONNSTATUS95 dwSize As Long RasConnState As Long dwError As Long szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type ضع هدا الكود في الفورم Public Function IsConnected() As Boolean Dim TRasCon(255) As RASCONN95 Dim lg As Long Dim lpcon As Long Dim RetVal As Long Dim Tstatus As RASCONNSTATUS95 TRasCon(0).dwSize = 412 lg = 256 * TRasCon(0).dwSize RetVal = RasEnumConnections(TRasCon(0), lg, lpcon) If RetVal <> 0 Then MsgBox "ERROR" Exit Function End If Tstatus.dwSize = 160 RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus) If Tstatus.RasConnState = &H2000 Then IsConnected = True Else IsConnected = False End If End Function Private Sub Command1_Click() If IsConnected() = True Then MsgBox ("الجهاز متصل بالانترنت") Else MsgBox ("الجهاز غير متصل بالانترنت") End If End Sub فيديو تشغيل ملف فيديو في picture ضع هدا الكود في الفورم Private Sub Form_Load() MMControl1.FileName = ("c:\FileName.dat") MMControl1.Command = "open" MMControl1.hWndDisplay = Picture1.hWnd End Sub تشغيل ملف من نوع avi بدون أوات ضع هدا الكود في الفورم Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Sub Form_Click() Dim Ret As Long, A$, x As Integer, y As Integer x = 10 y = 10 A$ = "c:\Filename.avi" Ret = mciSendString("stop movie", 0&, 128, 0) Ret = mciSendString("close movie", 0&, 128, 0) Ret = mciSendString("open AVIvideo!" & A$ & " alias movie parent " & Form1.hWnd & " style child", 0&, 128, 0) Ret = mciSendString("put movie window client at " & x & " " & y & " 0 0", 0&, 128, 0) Ret = mciSendString("play movie", 0&, 128, 0) End Sub Private Sub Form_DblClick() End End Sub Private Sub Form_Terminate() Dim Ret As Long Ret = mciSendString("close all", 0&, 128, 0) End Sub صورة التقاط صورة للشاشة ضع هدا الكود في الفورم Const RC_PALETTE As Long = &H100 Const SIZEPALETTE As Long = 104 Const RASTERCAPS As Long = 38 Private Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As Byte End Type Private Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID 'Fill GUID info With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Fill picture info With Pic .Size = Len(Pic) ' Length of structure .Type = vbPicTypeBitmap ' Type of Picture (bitmap) .hBmp = hBmp ' Handle to bitmap .hPal = hPal ' Handle to palette (may be null) End With 'Create the picture R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 'Return the new picture Set CreateBitmapPicture = IPic End Function Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE 'Create a compatible device con hDCMemory = CreateCompatibleDC(hDCSrc) 'Create a compatible bitmap hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) 'Select the compatible bitmap into our compatible device con hBmpPrev = SelectObject(hDCMemory, hBmp) 'Raster capabilities? RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster 'Does our picture use a palette? HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette 'What's the size of that palette? PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Set the palette version LogPal.palVersion = &H300 'Number of palette entries LogPal.palNumEntries = 256 'Retrieve the system palette entries R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) 'Create the palette hPal = CreatePalette(LogPal) 'Select the palette hPalPrev = SelectPalette(hDCMemory, hPal, 0) 'Realize the palette R = RealizePalette(hDCMemory) End If 'Copy the source image to our compatible device con R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) 'Restore the old bitmap hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Select the palette hPal = SelectPalette(hDCMemory, hPalPrev, 0) End If 'Delete our memory DC R = DeleteDC(hDCMemory) Set hDCToPicture = CreateBitmapPicture(hBmp, hPal) End Function Private Sub Form_Load() 'Create a picture object from the screen Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY) End Sub كود بسيط لالتقاط صورة للشاشة في الحافظة ضع هدا الكود في الفورم Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Sub Command1_Click() keybd_event vbKeySnapshot, 0, 0, 0 DoEvents End Sub صوت تشغيل ملف صوتي من نوع ram ضع هدا الكود في الفورم ولاحظ أنه يحتاج إلى الأداة الموجودة مع الريل بلاير Private Sub Command1_Click() RealAudio1.Source = "c:\AFR.ram" RealAudio1.DoPlay End Sub تشغيل ملف صوتي من نوع midi ضع هدا الكود في الفورم Private Sub Form_Load() MMControl1.Visible = False MMControl1.DeviceType = "sequencer" MMControl1.FileName = ("c:\FileName.mid") MMControl1.Command = "open" MMControl1.Command = "play" End Sub التحكم في رفع وخفض الصوت ضع هدا الكود في الفورم 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 1. End Sub Private Sub Form_Load() 1. = "ضع قيمة عددية تنحصر ما بين 0 و65536" End Sub الوقت والتاريخ معرفة اليوم الحالي ضع هدا الكود في الفورم Private Sub Command1_Click() Dim Dday As Integer Dday = Weekday(Date) If Dday = 1 Then Print "الأحد" If Dday = 2 Then Print "الاثنين" If Dday = 3 Then Print "الثلاثاء" If Dday = 4 Then Print "الأربعاء" If Dday = 5 Then Print "الخميس" If Dday = 6 Then Print "الجمعة" If Dday = 7 Then Print "السبت" End Sub معرفة الشهر الحالي ضع هدا الكود في الفورم Private Sub Command1_Click() Mmonth = Mid(Date, 4, 2) Print MonthName(Mmonth) End Sub الفرق بين تاريخين باليوم ضع هدا الكود في الفورم Private Sub Command1_Click() On Error GoTo 1 Dim Form1Date As Date Dim Form2Date As Date Form1Date = 1. Form2Date = 2. 3. = DateDiff("d", 1., 2.) & " اليوم" Exit Sub MsgBox ("من فضلك أدخل التاريخ بشكل صحيح") End Sub عرض الزمن والتاريخ ضع هدا الكود في الفورم Private Sub Form_Load() Timer1.Interval = 1000 End Sub Private Sub Timer1_Timer() Label1 = Time & Date End Sub الحماية نسخة مشتركة من البرنامج (تشتغل لعدد معين) ضع هدا الكود في الفورم Private Sub Form_Load() retvalue = GetSetting("A", "0", "Runcount") GD$ = Val(retvalue) + 1 SaveSetting "A", "0", "RunCount", GD$ If GD$ > 3 Then ' الرقم (3) يحدد عدد مرات التشغيل MsgBox ("انتهت مدة تشغيل البرنامج,قم بشراء النسخة الكاملة من المنتج") Unload Me End If End Sub منع النسخ أو اللصق ضع هدا الكود في الفورم Private Sub Form_Load() Timer1.Interval = 1 End Sub Private Sub Timer1_Timer() R = Clipboard.Get If Len® = 0 Then Clipboard.Clear End If End Sub منع تشغيل أكثر من نسخة من البرنامج ضع هدا الكود في الفورم Private Sub Form_Load() If App.PrevInstance = True Then MsgBox "لا يمكن تشغيل أكثر من نسخة من البرنامج" Unload Me Exit Sub End If End Sub التأكد من عمل البرنامج من على ال CD-ROM ضع هدا الكود في الفورم Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Sub Form_Load() Dim driveType As Long driveType = GetDriveType(Mid(App.Path, 1, 3)) If driveType <> 5 Then 'إنهاء البرنامج ادا كان لا يشتغل من القرص المدمج End End If End Sub التعامل مع النماذج جعل الفورم في المقدمة ضع هدا الكود في الفورم Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long Private Const SWP_NOMOVE = 2 Private Const SWP_NOSIZE = 1 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2 Public Sub SetOnTop(ByVal hwnd As Long, ByVal bSetOnTop As Boolean) Dim lR As Long If bSetOnTop Then lR = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) Else lR = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) End If End Sub Private Sub Form_Load() SetOnTop Form1.hwnd, True End Sub إبطال مفعول زر × في النافدة ضع هدا الكود في الفورم Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Cancel = True End Sub إلغاء تفعيل زر الإغلاق في أعلى النافدة ضع هدا الكود في الموديول 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 إلغاء تفعيل زر التكبير في أعلى النافدة ضع هدا الكود في الفورم Option Explicit 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 SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Sub Form_Load() Const WS_MAXIMIZEBOX = &H10000 Const GWL_STYLE = (-16) Const SWP_FRAMECHANGED = &H20 Const SWP_NOMOVE = &H2 Const SWP_NOSIZE = &H1 Dim nStyle As Long nStyle = GetWindowLong(Me.hWnd, GWL_STYLE) Call SetWindowLong(Me.hWnd, GWL_STYLE, nStyle And Not WS_MAXIMIZEBOX) SetWindowPos Me.hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE End Sub كود بسيط لجعل الفورم في المقدمة ضع هدا الكود في الفورم Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) Private Sub Form_Load() Timer1.Interval = 1 End Sub Private Sub Timer1_Timer() SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, 3 End Sub التعامل المجلدات إنشاء مجلد جديد ضع هدا الكود في الفورم Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDeor As Long bInheritHandle As Boolean End Type Private Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long Private Sub Command1_Click() Dim attr As SECURITY_ATTRIBUTES ' security attributes structure Dim rval As Long ' Set security attributes attr.nLength = Len(attr) 'size of the structure attr.lpSecurityDeor = 0 'normal level of security attr.bInheritHandle = 1 'default setting ' Create directory. rval = CreateDirectory(1., attr) End Sub Private Sub Form_Load() 1. = "c:\Abdu" Command1.Caption = "New Directory" End Sub البيانات نقل الملفات ضع هدا الكود في الفورم Private Sub Command1_Click() Name "c:\Autoexec.bat" As "D:\Autoexec.bat" End Sub حساب عدد سطور ملف نصي ضع هدا الكود في الفورم Private Sub Command1_Click() Open "c:\autoexec.bat" For Input As #1 Count: SS = SS + 1 Line Input #1, x If EOF(1) Then Label1.Caption = SS Exit Sub Else GoTo Count: End If Close End Sub تغيير خصائص ملف ضع هدا الكود في الفورم Private Sub COMMAND1_CLICK() SetAttr "C:\data.txt", vbHidden SetAttr "C:\data.txt", vbReadOnly SetAttr "C:\data.txt", vbArchive End Sub التأكد من وجود ملف ضع هدا الكود في الفورم Private Sub Command1_Click() On Error GoTo Error: Open "ضع مسار الملف الذي تريد التأكد من وجوده هنا" For Input As #1 Close MsgBox ("الملف موجود") Exit Sub Error: MsgBox ("الملف غير موجود") End Sub حجم الملف بالبايت ضع هدا الكود في الفورم Private Sub Command1_Click() Print FileLen("c:\Autoexec.bat") End Sub حذف ملف ضع هدا الكود في الفورم Private Sub Command1_Click() Kill ("C:\FileName.fnm") End Sub إنشاء ملف جديد ضع هدا الكود في الفورم Private Sub Command1_Click() open "c:\FileName.txt" for append as #1 Print #1,"Willkommen auf die Erde" Close #1 End Sub نسخ ملف ضع هدا الكود في الفورم Private Sub Command1_Click() FileCopy "c:\Autoexec.bat", "d:\Autoexec.bat" End Sub أكواد عامة فتح برنامج المفكرة و الإضافة عليه ضع هدا الكود في الفورم Private Sub Command1_Click() l "notepad.exe", vbNormalNoFocus AppActivate ("المفكرة") SendKeys ("أهلا بك ") End Sub عرض الخطوط في قائمة منسدلة ضع هدا الكود في الفورم Private Sub Form_Load() Dim i As Integer For i = 0 To Screen.FontCount - 1 Combo1.AddItem Screen.Fonts(i) Next i Combo1. = Combo1.List(0) End Sub أيقونة للبرنامج بجوار الساعة ضع هدا الكود في الموديول Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String * 64 End Type Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Const WM_MOUSEMOVE = &H200 Public Const WM_LBUTTONDOWN = &H201 'Button down Public Const WM_LBUTTONUP = &H202 'Button up Public Const WM_LBUTTONDBLCLK = &H203 'Double-click Public Const WM_RBUTTONDOWN = &H204 'Button down Public Const WM_RBUTTONUP = &H205 'Button up Public Const WM_RBUTTONDBLCLK = &H206 'Double-click Public Declare Function SetForegroundWindow Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function l_NotifyIcon Lib "l32" _ Alias "l_NotifyIconA" _ (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean Public nid As NOTIFYICONDATA ضع هدا الكود في الفورم Private Sub Form_Load() Me.Show Me.Refresh With nid .cbSize = Len(nid) .hWnd = Me.hWnd .uId = vbNull .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .uCallBackMessage = WM_MOUSEMOVE .hIcon = Me.Icon .szTip = "Your ToolTip" & vbNullChar End With l_NotifyIcon NIM_ADD, nid End Sub Private Sub Form_Resize() If Me.WindowState = vbMinimized Then Me.Hide End Sub Private Sub Form_Unload(Cancel As Integer) l_NotifyIcon NIM_DELETE, nid End Sub تأجيل تنفيذ الكود لفترة معينة ضع هدا الكود في الفورم Public Sub Delay(HowLong As Date) TempTime = DateAdd("s", HowLong, Now) While TempTime > Now DoEvents Wend End Sub Private Sub Command1_Click() Delay 5 MsgBox "Test" End Sub

ألــ 1000 ــف شكر وتقدير وتحية وفقك الله

السلام عليكم ورحمة الله وبركاته أرجو المساعدة لأنني أحاول أرسال رسالة لعنوانه على الهوتميل يعطيني بفشل الأرسال مما يحتمل أن البريد غير مستخدم أرجو أعطائي عنوان لأخي عمر وشكراً لكم ولماذا لم يظهر إلى الآن

ولكم جزيل الشكر

مشكور وفقك الله

أشكركم على المرور ولكم تحياتي

السلام عليكم ورحمة الله وبركاته اليك طريقة وضع رقم سري لملف اكسل ( وجدتها من موقع اجنبي ) في اعلى صفحة الاكسل اذهب الى ايقونة ادوات ==> خيارات ==> امان ==> ضعي الرقم السري في الخانتين ( واحد لعدم الاطلاع والاخر لعدم تغييير محتى الصفحة )==> ثم اضغط على خيارات متقدمة ==> اختاري RC4, Microsoft Enhanced Cryptographic Provider v1.0. من غير ان تغيري القيمة التي تظهر والتي هي 128===> اضغط على اوكي ===> اكد الرقم السري على مرتين ====> ثم احفظ عملك في مكان تعرفه جيدا مثل حقيبة الملفات او سطح المكتب للتاكد اعيد فتحه من جديد سيطالبك بالرقمين السريين ( يجب ان تحفظهما وسينبهك اكسل على ذلك ) والله اعلم شكرا لكل من أطلع على الموضوع