Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Enum CHOOSE_COLOR_FLAGS
&CC_RGBINIT = &H1& CC_FULLOPEN = &H2
&CC_PREVENTFULLOPEN = &H4
&CC_SHOWHELP = &H8
&CC_ENABLEHOOK = &H10
&CC_ENABLETEMPLATE = &H20
&CC_ENABLETEMPLATEHANDLE = &H40
&CC_SOLIDCOLOR = &H80
&CC_ANYCOLOR = &H100
End Enum
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As CHOOSE_COLOR_FLAGS
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare PtrSafe Function ChooseColor_API Lib
"comdlg32.dll" Alias "ChooseColorA" (lpChoosecolor As CHOOSECOLOR) As Long
#If Win64 Then 'Win64 = True, Win32 = False, Win16 = False
Private Declare PtrSafe Sub apiCopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long)Private Declare PtrSafe Sub apiExitProcess Lib "Kernel32" Alias "ExitProcess" (ByVal uExitCode As Long)Private Declare PtrSafe Sub apiSleep Lib "Kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)Private Declare PtrSafe Sub apiSetCursorPos Lib "User32" Alias "SetCursorPos" (ByVal X As Integer, ByVal Y As Integer)Private Declare PtrSafe Function apiBringWindowToTop Lib "User32" Alias "BringWindowToTop" (ByVal lngHWnd As Long) As LongPrivate Declare PtrSafe Function apiAttachThreadInput Lib "User32" Alias "AttachThreadInput" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As LongPrivate Declare PtrSafe Function apiCloseWindow Lib "User32" Alias "CloseWindow" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiEnumChildWindows Lib "User32" Alias "EnumChildWindows" (ByVal hWndParent As Long, ByVal pEnumProc As Long, ByVal lParam As Long) As LongPrivate Declare PtrSafe Function apiDestroyWindow Lib "User32" Alias "DestroyWindow" (ByVal hWnd As Long) As BooleanPrivate Declare PtrSafe Function apiEndDialog Lib "User32" Alias "EndDialog" (ByVal hWnd As Long, ByVal result As Long) As BooleanPrivate Declare PtrSafe Function apiExitWindowsEx Lib "User32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As LongPrivate Declare PtrSafe Function apiFindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPrivate Declare PtrSafe Function apiFindExecutable Lib "Shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVallpDirectory As String, ByVal lpResult As String) As LongPrivate Declare PtrSafe Function apiFindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare PtrSafe Function apiGetActiveWindow Lib "User32" Alias "GetActiveWindow" () As Long Private Declare PtrSafe Function apiGetClassNameA Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal szClassName As String, ByVal lLength As Long) As LongPrivate Declare PtrSafe Function apiGetDiskFreeSpaceEx Lib "Kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As LongPrivate Declare PtrSafe Function apiGetCommandLineParams Lib "Kernel32" Alias "GetCommandLineA" () As LongPrivate Declare PtrSafe Function apiGetCommandLine Lib "Kernel32" Alias "GetCommandLineW" () As Long Private Declare PtrSafe Function apiGetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Declare PtrSafe Function apiGetParent Lib "User32" Alias "GetParent" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiGetExitCodeProcess Lib "Kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Declare PtrSafe Function apiGetForegroundWindow Lib "User32" Alias "GetForegroundWindow" () As LongPrivate Declare PtrSafe Function apiGetLastError Lib "Kernel32" Alias "GetLastError" () As IntegerPrivate Declare PtrSafe Function apiGetFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As LongPrivate Declare PtrSafe Function apiGetSystemMetrics Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long Private Declare PtrSafe Function apiGetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As LongPrivate Declare PtrSafe Function apiGetWindowRect Lib "User32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As winRect) As LongPrivate Declare PtrSafe Function apiGetTickCount Lib "Kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As LongPrivate Declare PtrSafe Function apiGetTickCountMs Lib "Kernel32" Alias "GetTickCount" () As Long Private Declare PtrSafe Function apiGetUserName Lib "AdvApi32" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As LongPrivate Declare PtrSafe Function apiGetWindow Lib "User32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long Private Declare PtrSafe Function apiGetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal szWindowText As String, ByVal lLength As Long) As LongPrivate Declare PtrSafe Function apiIsZoomed Lib "User32" Alias "IsZoomed" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiIsCharAlphaNumericA Lib "User32" Alias "IsCharAlphaNumericA" (ByVal byChar As Byte) As LongPrivate Declare PtrSafe Function apiGetWindowThreadProcessId Lib "User32" Alias "GetWindowThreadProcessId" (ByVal hWnd As Long, lpdwProcessId As Long) As Long Private Declare PtrSafe Function apiIsIconic Lib "User32" Alias "IsIconic" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiIsWindowVisible Lib "User32" Alias "IsWindowVisible" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function apiLStrCpynA Lib "Kernel32" Alias "lstrcpynA" (ByVal pDestination As String, ByVal pSource As Long, ByVal iMaxLength As Integer) As LongPrivate Declare PtrSafe Function apiPathAddBackslashByString Lib "ShlwApi" Alias "PathAddBackslashW" (ByVal lpszPath As String) As Long 'http://msdn.microsoft.com/en-us/library/aa155716%28office.10%29.aspxPrivate Declare PtrSafe Function apiMessageBox Lib "User32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As LongPrivate Declare PtrSafe Function apiOpenIcon Lib "User32" Alias "OpenIcon" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function apiOpenProcess Lib "Kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPrivate Declare PtrSafe Function apiPathAddBackslashByPointer Lib "ShlwApi" Alias "PathAddBackslashW" (ByVal lpszPath As Long) As Long Private Declare PtrSafe Function apiPostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Declare PtrSafe Function apiSetFocus Lib "User32" Alias "SetFocus" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiRegQueryValue Lib "AdvApi32" Alias "RegQueryValue" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As LongPrivate Declare PtrSafe Function apiSendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function apiSetActiveWindow Lib "User32" Alias "SetActiveWindow" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiSetCurrentDirectoryA Lib "Kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long Private Declare PtrSafe Function apiSetForegroundWindow Lib "User32" Alias "SetForegroundWindow" (ByVal hWnd As Long) As LongPrivate Declare PtrSafe Function apiShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Declare PtrSafe Function apiSetWindowPlacement Lib "User32" Alias "SetWindowPlacement" (ByVal hWnd As Long, ByRef lpwndpl As winPlacement) As LongPrivate Declare PtrSafe Function apiSetLocalTime Lib "Kernel32" Alias "SetLocalTime" (lpSystem As SystemTime) As LongPrivate Declare PtrSafe Function apiSetWindowText Lib "User32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As LongPrivate Declare PtrSafe Function apiSetWindowPos Lib "User32" Alias "SetWindowPos" (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 LongPrivate Declare PtrSafe Function apiShowWindow Lib "User32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long Private Declare PtrSafe Function apiShowWindowAsync Lib "User32" Alias "ShowWindowAsync" (ByVal hWnd As Long, ByVal nCmdShow As Long) As LongpszDisplayName As StringPrivate Declare PtrSafe Function apiStrCpy Lib "Kernel32" Alias "lstrcpynA" (ByVal pDestination As String, ByVal pSource As String, ByVal iMaxLength As Integer) As LongPrivate Declare PtrSafe Function apiStringLen Lib "Kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long Private Declare PtrSafe Function apiStrTrimW Lib "ShlwApi" Alias "StrTrimW" () As BooleanPrivate Declare PtrSafe Function apiVarPtrArray Lib "MsVbVm50" Alias "VarPtr" (Var() As Any) As LongPrivate Declare PtrSafe Function apiTerminateProcess Lib "Kernel32" Alias "TerminateProcess" (ByVal hWnd As Long, ByVal uExitCode As Long) As Long Private Declare PtrSafe Function apiTimeGetTime Lib "Winmm" Alias "timeGetTime" () As Long Private Type browseInfo 'used by apiBrowseForFolder hOwner As Long pidlRoot As LonglpszTitle As String ulFlags As Long lpfn As LongEnd Type 'Find a specific window with dynamic caption from a list of all open windows: http://www.everythingaccess.com/tutorials.asp?ID=Bring-an-external-application-window-to-the-foregroundlParam As LongiImage As LongPrivate Declare PtrSafe Function apiBrowseForFolder Lib "Shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As browseInfo) As LongEnd TypePrivate Type CHOOSECOLOR 'used by apiChooseColor; http://support.microsoft.com/kb/153929 and http://www.cpearson.com/Excel/Colors.aspxlStructSize As Long hWndOwner As Long hInstance As Long rgbResult As Long lpCustColors As StringPrivate Declare PtrSafe Function apiChooseColor Lib "ComDlg32" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Longflags As Long lCustData As Long lpfnHook As Long lpTemplateName As String End TypePrivate Type FindWindowParameters 'Custom structure for passing in the parameters in/out of the hook enumeration function; could use global variables instead, but this is nicerstrTitle As String 'INPUT hWnd As Long 'OUTPUTPrivate Declare PtrSafe Sub apiGetLocalTime Lib "Kernel32" Alias "GetLocalTime" (lpSystem As SystemTime)Private Declare PtrSafe Function apiEnumWindows Lib "User32" Alias "EnumWindows" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As LongPrivate Type lastInputInfo 'used by apiGetLastInputInfo, getLastInputTime cbSize As Long dwTime As Long End Type'http://www.pgacon.com/visualbasic.htm#Take%20Advantage%20of%20Conditional%20CompilationPrivate Declare PtrSafe Function apiGetLastInputInfo Lib "User32" Alias "GetLastInputInfo" (ByRef plii As lastInputInfo) As LongwMonth As Integer'Logical and Bitwise Operators in Visual Basic: http://msdn.microsoft.com/en-us/library/wz3k228a(v=vs.80).aspx and http://stackoverflow.com/questions/1070863/hidden-features-of-vba Private Type SystemTime wYear As Integer wDayOfWeek As IntegerwDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type Private Type pointAPI 'used by apiSetWindowPlacement X As LongPrivate Declare PtrSafe Function apiInternetOpen Lib "WiniNet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long 'Open the Internet object 'ex: lngINet = InternetOpen(“MyFTP Control”, 1, vbNullString, vbNullString, 0)Y As LongEnd TypePrivate Type rectAPI 'used by apiSetWindowPlacementLeft_Renamed As Long Top_Renamed As LongPrivate Type winPlacement 'used by apiSetWindowPlacementRight_Renamed As Long Bottom_Renamed As Long End TypeptMinPosition As pointAPIlength As Long flags As Long showCmd As LongPrivate Declare PtrSafe Function apiGetWindowPlacement Lib "User32" Alias "GetWindowPlacement" (ByVal hWnd As Long, ByRef lpwndpl As winPlacement) As LongptMaxPosition As pointAPI rcNormalPosition As rectAPI End TypeRight As LongPrivate Type winRect 'used by apiMoveWindow Left As Long Top As Long Bottom As Long End TypePrivate Declare PtrSafe Function apiMoveWindow Lib "User32" Alias "MoveWindow" (ByVal hWnd As Long, xLeft As Long, ByVal yTop As Long, wWidth As Long, ByVal hHeight As Long, ByVal repaint As Long) As LongPrivate Declare PtrSafe Function apiFtpPutFile Lib "WiniNet" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean 'Send a file 'ex: blnRC = FtpPutFile(lngINetConn, “c:\dirmap.txt”, “dirmap.txt”, 1, 0)Private Declare PtrSafe Function apiInternetConnect Lib "WiniNet" 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 lContext As Long) As Long 'Connect to the network 'ex: lngINetConn = InternetConnect(lngINet, "ftp.microsoft.com", 0, "anonymous", "wally@wallyworld.com", 1, 0, 0)Private Declare PtrSafe Function apiFtpGetFile Lib "WiniNet" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean 'Get a file 'ex: blnRC = FtpGetFile(lngINetConn, "dirmap.txt", "c:\dirmap.txt", 0, 0, 1, 0)Private Declare PtrSafe Function apiFtpDeleteFile Lib "WiniNet" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean 'Delete a file 'ex: blnRC = FtpDeleteFile(lngINetConn, “test.txt”) Private Declare PtrSafe Function apiInternetCloseHandle Lib "WiniNet" (ByVal hInet As Long) As Integer 'Close the Internet object 'ex: InternetCloseHandle lngINetConn 'ex: InternetCloseHandle lngINet#ElseIf Win32 Then 'Win32 = True, Win16 = FalsePrivate Declare PtrSafe Function apiFtpFindFirstFile Lib "WiniNet" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As LongPrivate Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIMEEnd Type 'ex: lngHINet = FtpFindFirstFile(lngINetConn, "*.*", pData, 0, 0)ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * 1 'MAX_FTP_PATH cAlternate As String * 14Private Declare PtrSafe Function apiInternetFindNextFile Lib "WiniNet" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long 'ex: blnRC = InternetFindNextFile(lngHINet, pData)
ایجاد شی در حافظه ی موقت
Set tdfRoyalties= dbsCurrent.CreateTableDef("Royalties")
ایجاد کانکشن
=tdfRoyalties.Connect
" ODBC;DATABASE=pubs;DSN=Publishers"
تنظیم منبع شی ایجادشده
" tdfRoyalties.SourceTableName ="roysched
اضافه کردن جدول از دیتابیس دیگربه دیتابیس جاری
dbsCurrent.TableDefs.Append tdfRoyalties
خالی کردن از حافظه ی موقت
Set tdfRoyalties=Nothing
مثال دیگر دیتابیس اکسس با پسورد
& tblDef.Connect = "MS Access;DATABASE=" & RemoteDbName
"PWD=YourPassword"
cnX = "ODBC;DRIVER=SQL Server;SERVER=" & vServer & ";DATABASE=" & vDatabase & ";UID=" & vUserName
PWD=" & vPassword;" &
CurrentDb.CreateTableDef(vLocalTable,dbAttachSavePWD, vRemoteTable, cnX
TableDef
Attributes
ساخت جدول مشخصات مشتری با نام Customer_info
CustomerID
CustomerCD
CustomerTel
CustomerAddress
ساخت جدول متریال یا متریال های مورد نیاز قطعه ی تولیدی با نام Pro_Requirement
Pro_Itm_CD کد قطعه فرضا 120
Pro_Itm_Mat متریال قطعه فرضا کد 120 از ترکیب یا اسمبلی چهار متریال A-D حاصل میشود.
ساخت جدول قطعه شامل کد و شرح آن فرضا
Pro_Itm_CD کد آیتم قطعه ی تولیدی فرضا کد 120
Pro_Itm_Desc شرح قطعه
ساخت جدول شامل کد مشتری کد قطعه تعداد قطعه ی موردنیاز مشتری تعداد قابل تولید ( کامل ) کسری تاریخ با نام Customer_Requirement
Pro_CustomerID
Pro_Itm_CD
Pro_Itm_Qty
Supplied چک باکس برای زمانیکه اگر حتی یک قطعه را می شد تامین کرد تیک بخورد ( فرضا در کانتینیوس فرم باتنی دارید که از طریق آن و لوپ در تعداد موردنیاز مشتری اپند انجام می گیرد )
Suppplied_Doc
Supplied_Qty
ساخت جدول شامل ثبت مواد ورودی و مواد مصرف شده برای ساخت قطعاتی که مواد اولیه ی آن کسری ندارد با نام Pro_Entry
(زمانیکه در فرم شما کار تخصیص متریال به قطعه را انجام می دهید بعد از تایید نهایی توسط کارفرما به این جدول با داکیومنت نامبری که خودتان تشخیص می دهید اپند میشود)
Pro_Itm_Mat
Pro_Itm_Type کمبو باکس شامل لیست Entry و Exit
Pro_Itm_Doc
Pro_Itm_Dt
Pro_Itm_Qty
ساخت جدول موقت یا Temp برای اضافه شدن متریال یا متریالهای قطعه کد موردنظر از جدول Pro_Requirement از آیدی ۱ تا عدد درخواست مشتری یا نام Pro_Allocative ( محتویات این جدول در هر بار تخصیص دادن باید با کوئری دیلیت حذف شوند . )
Pro_Customer_ID
Pro_Itm_ID
Pro_Itm_CD
Pro_Itm_Mat
Pro_Itm_Qty
Pro_Itm_Pos
Pro_Itm_Inventory برای این فیلد اگر نال بود ( در اولین اپند ) از کوئری Inventory بازیابی می کند و در اپند های بعدی مقدار فیلد Pro_Itm_Inventory میشود حاصل تفریق این فیلد و Pro_Itm_Qty در همین جدول موقت در صورتیکه Pro_Itm_ID برابر Dmax آیدی در همین جدول موقت باشد.
Pro_Itm_Pos اگر تفریق Inventory و Qty مثبت بود True در غیر اینصورت False در نظر می گیرد .
ساخت کوئری Inventory و کسر سام تعداد ثبت شده ی تایپ Entry و سام تعداد تخصیص یافته ی قطعه ی کامل شده با تایپ Exit از جدول Pro_Entry
اگر طبق جدول Pro_Entry عمل کنید به موجودی زیر خواهید رسید
ساخت کوئری اپند با نام Append_To_Allocative که محتویات داخل جدول Pro_Requirement را با توجه به کدقطعه و موجودی متریال مورد نیاز قطعه از کوئری Inventory به جدول موقت Pro_Allocative اضافه می کند مضاف بر اینکه به جدول موقت Id میدهد ( Pro_Itm_ID ) که از یک شروع ( Dmax در جدول موقت و با Nz اگر Null بود صفر اگر Null نبود یک شماره اضافه کند ) و به تعداد موردنیاز مشتری ختم می شود البته باید در لوپ و در فرم اجرا شود که بیشتر اضافه نکند.چیزی که باید در نظر گرفت این است که در فرم چک باکسی تعبیه گردد که در صورت تخصیص دادن حتی یک قطعه تیک خورده و از زدن باتن دوباره ی اپند جلوگیری شود .
زمانیکه اپند به تعداد قطعه ی موردنیاز مشتری به جدول موقت Pro_Allocative انجام شد میشود از این جدول کوئری نوشت که با توجه به Pro_Itm_ID کانت تعداد True ها در فیلد Pro_Itm_Pos را بدست آورد و در شرط کانت هم با Dcount تعداد متریال های ساخت یک قطعه را با توجه به کد قطعه از جدول Pro_Requirement بدست آورد ... فرض کنید تعداد متریال مورد نیاز کد قطعه ای 4 آیتم باشد ( از جدول Pro_Requirement با توجه به فیلد Pro_Itm_CD استخراج می شود ) در جدول موقت اگر تعداد هر آیدی قطعه برابر 4 بود با توجه به شرط True بعنوان یک قطعه ی کامل در نظر گرفته میشود و می توانید با Dcount در همین Pro_Itm_ID تعداد آیدی ها را بدست آورد و در نتیجه خواهید فهمید چند قطعه ی کامل برای مشتری قابل ساخت است از تعداد چیزی که سفارش داده . بعدا میتوانید با کوئری دیگری کسری های متریال در Id قطعاتی که کانت آنها با توجه به شرط True مخالف کانت متریال در جدول Pro_Requiremenr است را بدست آورید.
قدم اول در هنگام اجرای باتن پاک کردن :
("db.Execute ("Delete from Pro_Allocative
قدم دوم لوپ به تعداد فیلد Pro_Itm_Qty که 15 هست :
For i = 1 To15
("db.Execute ("Append_To_Allocative
Next
طبق کوئری 3 تعداد 8 قطعه آماده ی ساخت و تحویل به مشتریست Expr2 حاصلضرب Pro_Itm_qty متریال قطعه در تعداد تحویلی که 8 است Expr1
زمانیکه از Allocate متریال یا متریال هایی برای قطعه کد موردنظر مشتری اطمینان حاصل کردید حتی اگر یک قطعه ی کامل باشد و کارفرما هم در صورت عدم تامین سایر تعداد این قطعه کد رضایت داشته باشد در اینجا شما باید با داکیومنت نامبری خروج مواد را صادر و به جدول Pro_Entry ( محل ثبت ورود متریال و خروج متریال مورد نیاز قطعه کد مشتری ) بفرستید با یک کوئری اپند دیگر که شماره داکیومنت فرضا میشود آخرین شماره ی ثبت شده در تیپ Exit در همین جدول باضافه ی یک ، برای اینکار هم از تعداد آیدی کد قطعاتی که متریال آنها کامل شده در تعداد موردنیاز متریال آن قطعه کد در جدول Pro_Requirement استفاده می کنید.
طبق جدول Pro_Allocative در بالاتر قطعه کد 120 تعداد 7 قطعه کامل و آماده ی ساخت است و قطعه کد 8 تا 15 درمتریال D کسرس دارند که جمع کل کسری 50 قطعه است
تنظیم هر عنصربه صفر یا به "" منظور ( طول رشته به صفر ) یا آزاد کردن فضای اشغال شده )
Dim DynamicArray() As Integer ' Dynamic array.
Erase DynamicArray ' Free memory used by array.
SendMessageA HandleWindow,WindowseMessage,Wparam(ScrollBar
Constants),lparam:Null
MultipleImage
img() array : Store Image name
Redim Preserve : Store Image Name In Array Through Loop In Image Folder Using Dir
( image.Tag ( Store Img Number
Loop In Image Control And Set Picture Property To Specified Path And Image Name
First Imaging Then Executing
ImageControl: Image0 Till Image4
ImageCount :In Folder icofolder=13
Next : Tag=Tag+1
1-5
2-6
3-7
4-8
5-9
6-10
7-11
8-12
Previous : Tag=Tag-1
7-11
6-10
5-9
4-8
3-7
2-6
1-5
0-4
Last : Tag=(ImageCount-1)-4+i
8-12
First : Tag=I
0-4
For Each Ctl In Me.Detail.Controls
.
.
.
i=i+1
Next
ImageCount=i
برنامه ی اکسس با قیمت مناسب میخواهید ؟
مرجع کامل اکسس ۲۰۱۶ که در بازار موجوداست را تهیه کرده و گام به گام با داکیومنت اکسس پیش بروید در کمتر از یکماه می توانید پروژه ی مناسب با نظر خودتان را بنویسید
Docmd.Rename NewName, ObjectType, OldName
Docmd.CopyObject ObjectName
Docmd.DeleteObject ObjectName
Type Of Object ... acObjectType
Commands And Functions
.RefreshRecord (DoCmd) Refresh the data in a form..Rename (DoCmd) Rename an object..RepaintObject (DoCmd) Complete any pending screen updates.Replace Replace a sequence of characters in a string..Requery Requery the data in a form or a control..Restore (DoCmd) Restore a maximized or minimized window.RGB Convert an RGB color to a number.Right Extract a substring from a string.Rnd Generate a random number.Round Round a number to n decimal places.RTrim Remove trailing spaces from a string..RunCommand Run an Access menu or toolbar command..RunDataMacro (DoCmd) Run a named data macro..RunMacro (DoCmd) Run a macro..RunSavedImportExport (DoCmd) Run a saved import or export specification..RunSQL (DoCmd) Run an SQL query.
.SetOrderBy (DoCmd) Apply a sort to the active datasheet, form or report..SetParameter (DoCmd) Set a parameter before opening a Form or Report..SetWarnings (DoCmd) Turn system messages on or off.Sgn Return the sign of a number..ShowAllRecords(DoCmd) Remove any applied filter..ShowToolbar (DoCmd) Display or hide a custom toolbar.Shell Run an executable program.
Extract Color Text / Rng As Range
(xValue=Rng.Text (Formatted Text
(For........Next ..... Len(xValue
Rng.Characters(i,1).Font.Color=VbRed
(Out=Out& Mid(xValue,i,1
منبع : اینترنت
The following function helps Excel identify if a character is a special character, like #, @, and !
Function IsSpecial(strValue As String) As BooleanDim intPos As Integer(For intPos = 1 To Len(strValue(Select Case Asc(Mid(strValue, intPos, 1Case 33 To 47, 58 To 64, 91 To 96, 123 To 126IsSpecial = TrueCase ElseIsSpecial = FalseExit ForEnd SelectNextEnd Function
داکیومنت آفیس را بیشتر مطالعه کنید
در رویداد SelectionChange
Target.Characters(....).Font.Color/ColorIndex
کد اسکی اعداد در اینترنت هست ، قسمت Numpad هم کد جداگانه دارد و لوپ زدن در طول رشته در سل انتخابی
در ماژولتون و رویداد تغییرانتخابی در رنج و سل مورد نظر(Cel.Characters(i,1 داخل طول کاراکتر رنگ فونت کاراکتراگر کد اسکی آن برابر عدد بود را عوض می کنید ( راهنمایی بسیار ارزنده )
چک میکند اگر کاراکتر فرضا [Like [0-9 یا اسکی کد آن با جدول بالا یکی بود فونت آن کاراکتر تغییر بنماید.
"String= "A1B2C3D4
تصور کردیم و بعد اجرا البته کد در نت زیاده
1-لوپ زدن در طول String بالا با دستور For...Next و تابع Len
2-استفاده از تابع Mid و البته قبل از آن تعریف متغیری از نوع Boolean که اگر کاراکتر عددی در String پیدا کرد True شود ( استفاده از تابع IsNumeric برای چک کردن عددی بودن کاراکتر ) و در متغیر دیگر Store شود
در طول رشته حرکت میکند یک کاراکتر یک کاراکتر اگر عدد بود در متغیری ذخیره می کند اینجا همان Ret است و حلقه تا زمانی ادامه پیدا میکند که متغیر تعریف شده ( i ) از نوع Integer یا Long با طول رشته که در اینجا با تابع Len بدست آمده و هشت است برابر شود
تابع Mid کاراکتر یا کاراکترهای موردنظر شما را در رشته برمی گرداند قسمت اول نام رشته قسمت دوم آن Start منظور از کدام کاراکتر شروع شود و قسمت سوم آن طول یا تعداد کاراکترکه باید برگرداند است
(Len(String
CheckDigit As Boolean
((IsNumeric(Mid(String,i,1
(Ret=Ret & Mid(String,i,1
: Subsequently
Ret=1234
علامت ! منظور مخالف
علامت * هر کاراکتر یا عدد
علامت [] در این بازه تک کاراکتر فرضا *[Like [!a-c بغیر از آنهایی که کاراکتر اولشون با a یا b یا c شروع شده باشد یعنی کاراکتر اولشون شامل a تا c نباشد
علامت # اعداد
علامت ? تک کاراکتر
در VBA :
Single Character Example
if Not Varx Like "[0-9][4-5]*" Then
در Input Mask
0 ورود عدد اجباری
9 ورود عدد اختیاری
L ورود حروف و اجباری
فرض کنید در جدولی تعدادی رکورد وجود دارد که فیلدی از آن شامل کاراکتر ? است و میخواهید رکوردهایی از این فیلد که دارای آن علامت است را فیلتر کنید و این علامت ممکن است در اول وسط یا انتهای مقدار فیلد باشد . ( کاراکتر را در براکت می گذارید )
*[?]*