Create TextFile

VBA Code:

Sub Ger_sinal()
Dim sinal() As integer

ReDim sinal(3)

'Test values
 sinal(0) = -22306
 sinal(1) = 5836
 sinal(2) = 0
 sinal(3) = 23326

'Creates a file and puts the values in it
Dim n_arq As Integer
Dim path As String
path = "C:\Users\DELL\Desktop\App\WAVs\Sinal_VBA.wav"
 
     Set fs = CreateObject("Scripting.FileSystemObject")
     Set a = fs.CreateTextFile(path, True)
     a.Close
    
     n_arq = FreeFile
     Open path For Binary As n_arq

     Put n_arq, , sinal
    Close n_arq

End Sub

آبجکت Adodb.Stream برای لود کردن فایل در فیلد باینری

راه های زیادی برای لود کردن فایل به bytearray وجود دارد .که میتوان از آبجکت ADODB.Stream استفاده نمود.

Dim db As DAO.Database
Dim rst As DAO.Recordset

Set db = CurrentDb
Set rst = db.OpenRecordset("dbo_WATER_FILES", dbOpenDynaset, dbSeeChanges)
rst.Edit
Dim strm As Object
Set strm = CreateObject("ADODB.Stream")
strm.Type = 1 'adTypeBinary
strm.Open
strm.LoadFromFile "C:\test.jpg"
rst.Fields("Binary_File").Value = strm.Read 'FileData
strm.Close
rst.Update

برای برگشت باینری به یک فایل : 

With CreateObject("ADODB.Stream")
    .Type = 1 'adTypeBinary
    .Open
    .Write  rst.Fields("Binary_File").Value
    .SaveToFile "C:\testcopy.jpg", 2 'adSaveCreateOverWrite
    .Close
End With

تبدیل باینری به تکست یا تکست به باینری هم از همین آبجکت

می توان بهره برد.

Field Name
Description
FileData
The file itself is stored in this field.
FileFlags
Reserved for future use.
FileName
The name of the file in the attachment field.
FileTimeStamp
Reserved for future use.
FileType
The file extension of the file in the attachment field.
FileURL
The URL for the file for a linked SharePoint list. Will be Null for local Access tables.

Whatsapp Message

How to send Whatsapp messages without saving the 

number

Use AddressBar :

IE.navigate "whatsapp://send?phone=5511912341234&text=something" '

Whatsapp Message

برای ارسال فایل حتما باید به یک درگاه باصطلاح خودشون امن وارد بشوید که خب پولیه و مجانی نیست !!!

whatsapp/send-file

gateway-endpoints برای ارسال فایل البته پرداخت ماهیانه 

ارسال پیام  از طریق web ،  فقط از روی کامپیوتر و اسکن کیو آر کد توسط گوشی 

How to send Whatsapp messages without saving the 

number

1. How to send Whatsapp messages without saving the number
2. Open the web browser and then paste ‘https://api.WhatsApp.com/send?phone=number’ in the Address bar of your phone’s browser. 
 
3. In the place of “number”, enter the phone number of the person to whom you want to send a WhatsApp message with the country code.
 
4. Omit any zeroes, brackets or dashes when adding the phone number in international format.
 
5. The number that you provided should have a WhatsApp account.
 
6. Click on “Message” button.
 
7. You will be taken to the WhatsApp app with a chat being open for the said contact.

  Application.FollowHyperlink method:

Application.FollowHypwrlink "http://web.whatsapp.com/"

برای باز کردن فایلها مثل اکسس ، ورد هم استفاده میشود.

Application.FollowHyperlink "D:\text.accdb"

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

 

CreateObject("WScript.Shell")

wShell.Sleep 1000

"https://web.whatsapp.com/send?phone='"+phone_no+'" & "&text='"+message & "'"

how-to-use-click-to-chat

Send Message To WhatsApp If Number Available

پس باید شماره در لیست شماره های تلفن شما باشد و همچنین اپلیکیشن بازشده باشد. ( تلفن با کد کشور بدون صفر و پرانتز یا براکت اضافه !!!

Application.FollowHyperlink  "https://wa.me/975777723456?text=Hi"

خیلی ساده و کاربردی توسط WhatsApp توصیه شده و برای استفاده از کاربرانی است که میخواهند پیامی را به مخاطب یا مخاطبان لیست خودشون در whatsapp بفرستند فرضا فایل اکسلی دارید در ستونی شماره تماس مخاطباتون که هم در واتساپ هست و هم آنها واتساپ دارند اضافه می کنید سپس طبق لینک بالا در Address می گذارید و ارسال می شود.

در زیر اگر تلفن در CONTACT LIST شما باشد پیام روی واتساپ نمایش داده می شود ولی احتیاج به فشردن کلید SEND است که برای اینکار میشوداز  SENDKEYS استفاده نمود.

https://api.whatsapp.com/send?phone=979109077999&text=dummy

https://wa.me/whatsappphonenumber/?text=urlencodedtext. For example, if you have to send a message that says “How are you?” to an unsaved number 9988776655, this will be the final URL that you will need to enter – https://wa.me/919988776655?text=How%20are%20you%20?

بخاطر اینکه در بستر وب انجام میشود و برای هر ارسال یک تب جدید باز میشود می توان CTRL+W را با SENDKEYS فرستاد تا برنامه را در همان ویندو ببندد 

Ctrl+W is a shortcut key most often used to close a program, window, tab, or document. Alternatively referred to as Control W and C-w, Ctrl+W is a shortcut key most often used to close a program, window, tab, or document.

Sleep Api use 

SendKeys "{Enter}"

TVRoY6bQ

لطفا نظر سنجی فراموش نشود !!!

ارسال فایل 

https://faq.whatsapp.com/general/whatsapp-business-api/getting-access-to-business-api/

https://www.whatsmate.net/whatsapp-image-individual-api.html

Whatsapp uses TCP 443 (HTTPS) to pass the majority of the connection traffic but it also uses TCP 80 (HTTP). If voice is used, then ports 4244, 5222, 5223, 5228,50318, 59234 & 5242 are used.

UDP Ports: 34784, 45395, 50318, 59234.

Are you limiting outgoing port via the Egress firewall? If yes you need to give access to ports 5222,5223 and 5228. This is for Whatsapp calling.

Text messages should work by default as far as I am aware (as port 80 and 443 are used which are usually open)

کاربرد چند تابع API در فرم

در رویداد Open فرم Child :

hParent = FormParent.hwnd

hChild = FormChild.hwnd

SetParent hChild, hParent

SetWindowPos hChild, hParent, 163, 44, 725, 437, &H4

Private Type Rect

Left,Top,Right,Bottom As Long

End Type

در رویداد Resize فرم Child :

Dim mainRECT As RECT 

hParent = FormParent.hwnd

hChild = FormChild.hwnd

GetWindowRect hParent, mainRECT

uFlags last Arguman in SetWindowPos (swp ) Function
&H80   'hidewindow
&H20   'draw frame
&H2     'no move
&H400 'no send changing
&H4      ' ignores the hWndInsertAfter parameter
&H40   'Showwindow

SetWindowTexA hWnd,lpString  تغییر کپشن پنجره

SetDlgItemTextA hDlg,nIDDlgItem,lpString تغییر تکست کنترل

GetClassNameW hWnd,lpClassName,nMaxCount  گرفتن کلاس پنجره

کلاس مسیج باکس 32770# است اگر اشتباه نکنم  ،  در window-classes می توانید مشاهده بنمائید. با  تابع EnumChildWindows  و قرار دادن EnumProc به True می توان کلاس های Child  پنجره اصلی را گرفت 

ShowWindow  hWnd, nCmdShow  حالت نمایش پنجره فرضا مخفی کردن یا مینیمایزکردن حتی جای آرگومان آخر صفر بگذارید پنجره مخفی می شود

 اگر آرگومان دوم که کپشن ویندو است خالی باشد نتیجه ( قسمت Title ) با هر پنجره ای که Match شود برگردانده میشود که 32770 کلاس Dialog Box است اگر خطا بدهد نتیجه NULL است  ، اگر آرگومان اول خالی باشد نتیجه طبق همان آرگومان دوم که Title است برگردانده میشود فرضا در مسیج باکس می توانید از آرگومان دوم که بتواند هندل درستی به این پنجره باشد استفاده بنمائید.

FindWindowW "#32770", VbnullString  

برای جستجو  در  پنجره های Child  استفاده از  FindWindowEx.

تابع زیر برای شمردن پنجره های   Child  که متعلق به پنجره مادر یا Parent مشخص شده است با عبور هندلی به هر پنجره Child

EnumChildWindows hWndParent,lpEnumFunc,lParam

آرگومان دوم استفاده از AddressOf قبل از lpEnumFunc

فرضا Parent پنجره ای با کلاس دیالوگ باکس یعنی 32770# و آرگومان دوم آدرسی به تابعی جهت لوپ در این پنجره. مثل

EnumChildProc hWnd,lParam

که hWnd هندلی است به پنجره Child و برای شمارش می بایست این تابع برابر True قرار گیردو برای Stop برابر False 

EnumChildProc=True

Public Function EnumChildProc(ByVal hWnd As Long,ByVal lParam As Long)

اینجا می توان از تابع GetClassNameA استفاده کرد و  Class و Title هر پنجره Child را استخراج کرد ( hWnd ) یا حتی GetWindowTextA

EnumChildProc=True

خط بالا برای ادامه شمارش و برای خاتمه دادن به شمارش از False استفاده می کنیم 

Exit Function

برای تغییر لوکیشن هر پنجره Child می توان از تابع    movewindow   استفاده نمود. از showwindow هم برای مخفی کردن پنجره Child.

تابع زیر اگر استفاده شود ماوس کلیک یا ورودی با کیبورد در کنترل اثری ندارد البته مقدار آرگومان دوم False باشد.

EnableWindow hWnd,bEnable

برای ساختن  Timer : 

SetTimer hWnd,nIDEvent,uElapse,lpTimerFunc

تخریب Timer مشخص شده : 

KillTimer hWnd,uIDEvent

پست یک پیام به پنجره  مثل ارسال WM_CLOSE برای بستن پنجره مشخص شده : 

PostMessageA hWnd,Msg,wParam,lParam

فعال ، غیرفعال یا خاکستری کردن آیتم منو : 

EnableMenuItem hMenu,uIDEnableItem,uEnable

uIDEnableItem : 

MF_BYCOMMAND=&H0

 نشان میدهد که  IDEnableitem یک نشانگری به آیتم منو می دهد فرضا اگر آیتمی در منو در نظر باشد باید اشاره شود.

MF_GRAYED=&H1

 غیرفعال و خاکستری و نمی تواند انتخاب شود

MF_DISABLED=&H2

غیرفعال ولی خاکستری نمیشود نمی تواند انتخاب شود

گرفتن هندل منوی پنجره ،  همان کلوز و مینیمایز و ماکزیمایزدرفرم : آرگومان دوم باید حتما 0 یا False باشد.

hMenu=GetSystemMenu(hWnd,bRevert)

مثال از دو تابع گرفتن هندل منوی فرم و تابع فعال یا غیر فعال کردن پنجره  :

hMenu=GetSysMenu(.hWnd,False)

EnabledWindow hMenu,False

تغییر ویژگی پنجره :

SetWindowLongPtrA hWnd,nIndex,dwNewLong

nIndex  : GWL_STYLE=-16    تغییر استایل پنجره

dwNewLong : 

WS_MAXIMIZE=&H1000000
WS_MINIMIZE=&H20000000
WS_MAXIMIZEBOX=&H10000 'باتن ماکزیمایز
WS_MINIMIZEBOX=20000 'پنجره باتن مینیمایز دارد
WS_SYSMENU=&H80000 'پنجره یک منو دارد در قسمت تایتل
WS_TABSTOP=&H10000 ' فوکس کیبورد
WS_CLIPCHILDREN=&H2000000 'زمان ساخت پرنت ویندو استفاده می شود
WS_CHILD=&H40000000 ' پنجره با این استایل نمی تواند نوار منویی داشته باشد
WS_CAPTION=&HC00000 'پنجره تایتل بار دار با بوردر

تابعی برای گرفتن ابعاد screen  :

GetSystemMetrics nIndex ' Lib user32

فقط یک آرگومان دارد از user32.dll ، اگر nIndex صفر باشد X را بر می گرداند (  به پیکسل )  و یک باشد Y را بر میگرداند.

X=GetSystemMetrics(0)

Y=GetSystemMetrics(1)

توابع مربوط به منو :

هندل به منوی پنجره مشخص شده

GetMenu hWnd  ' lib user32

تعیین تعداد آیتم ها در منوی مشخص شده

GetMenuItemCount hMenu  ' lib user32

حذف منو البته نه حذف منطقی اگر آیتم منو یک منوی دراپ داون یا ساب منو را باز کند عملی صورت نخواهد گرفت

RemoveMenu hMenu,uPosition,uFlags ' lib user32

uFlags :

MF_BYCOMMAND=&H0

MF_BYPOSITION=&H400

آپدیت کردن منو بار زمان تغییرات اعمال شده :

DrawMenuBar hWnd ' lib user32

گرفتن هندل با منوی دراپ داون یا ساب منو

GetSubMenu hMenu,nPos 'lib user32

'get menu

hMenu= GetMenu(MainWindowHandle)

'get item count

count = GetMenuItemCount(hMenu)

'loop & remove

for  i = 0 to count

RemoveMenu hMenu,0, (MF_BYPOSITION Or MF_REMOVE)

'force a redraw

DrawMenuBar MainWindowHandle

تغییر اطلاعات درباره آیتم منو البته طبق تنظیم استراکچری که دارد

SetMenuItemInfoA hmenu,item,fByPositon, lpmii

Public Type MENUITEMINFOA

cbSize As Long

fMask As Long

fType

fState

wID

hSubMenu As Long

hbmpChecked

hbmpUnchecked

dwItemData As Long

dwTypeData As String

cch As Long

hbmpItem As Long

End Type

'fmask
MIIM_BITMAP=&H80
MIIM_STATE=&H1
MIIM_STRING=&H40 'dwTypeData
MIIM_FTYPE=&H100 'ftype

'Menu fType
MFT_BITMAP=&H4
MFT_BITMAP is replaced by MIIM_BITMAP and hbmpItem.
MFT_STRING=&H0

'Menu item state
MFS_DISABLED=&H3
MFS_GRAYED=&H3
MFS_HILITE=&H80

cch: The length of the menu item text, in characters

طول متن مورد منو ، به صورت کاراکتر ، هنگامی که اطلاعات مربوط به آیتم منو از نوع MFT_STRING دریافت می شود. با این حال ، cch فقط در صورتی استفاده می شود که پرچم MIIM_TYPE در عضو fMask تنظیم شده باشد و در غیر این صورت صفر باشد. همچنین وقتی محتوای یک آیتم منو با فراخوانی SetMenuItemInfo تنظیم می شود ، cch نادیده گرفته می شود.

عضو cch از MENUITEMINFOA کاربردش زمانی است که پرچم MIIM_STRING در عضو fMask تنظیم شده باشد.

برای بازیابی آیتم منوی تایپ MFT_STRING ، اول سایز رشته را با تنظیم عضو dwTypeData از MENUITEMINFO به NULL پیدا کنید و سپس تابع GetMenuItemInfo را فراخوانی کنید. مقدار cch+1 سایزی است که مورد نیاز است.سپس بافری را تخصیص دهید ،   یک نشانگر به بافر در dwTypeData قرار دهید ، افزایش cch و یکبار دیگر تابع GetMenuItemInfo را صدا بزنید تا بافر را با رشته پر کند.

طبق دستورالعمل داکیومنت آفیس عمل می کنیم شما تست بفرمائید اگر درست نبود اصلاح شده در نظرات همین پست قید گردد 

Dim Mii As MENUITEMINFOA

With Mii

.cbSize=Len(MENUITEMINFO)

.fMask=&H40 'MIIM_STRING

.dwTypeData=vbNullString

End With 

با GetMenu میشود هندل منوی پنجره را بدست آورد و در 

hMenu قرار داد.

GetMenuItemInfo hMenu,0,True,&Mii

سپس اضافه کردن یک به cch

Mii.cch=Mii.cch+1

Mii.dwTypeData = Space(mii.cch)

Mii.fMask=&H40 Or &H2

' Retrieve data  بازیابی داده

GetMenuItemInfo(hMenu, wParam(ItemNumber),True,&mii)

------------------------------

wCaption = String$(256, 0)
    hwnd = GetActiveWindow  ؟؟؟؟  دقیق نیست
    retVal = GetWindowText(hwnd, wCaption, 255)
    wCaption = Left$(wCaption, retVal)
    If InStr(1, wCaption, "Microsoft Excel", vbTextCompare) = 0 Then
      Exit Sub
    End If

    hSysMenu = GetSystemMenu(hwnd, 0)
    Count =GetMenuItemCount(hSysMenu)

RemoveMenu hSysMenu, Count-1,MF_REMOVE Or MF_BYPOSITION)
RemoveMenu(hSysMenu, Count-2, MF_REMOVE Or MF_BYPOSITION)



Private Const MF_BYCOMMAND = &H0
Private Const SC_CLOSE = &HF060

MnuHandle = GetSystemMenu(handleWindow, ByVal 0)
lRetVal=DeleteMenu(l_lMenuHandle, SC_CLOSE,MF_BYCOMMAND)

---------------SYSMENU-------------

Public Declare Function GetMenu Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32.dll" (ByVal hMenu As Long) As Long


Public Declare Function Lib "user32.dll" Alias "GetMenuItemInfoA" (ByVal _ hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As _ MENUITEMINFO) As Long


hMenu=GetMenu(hWnd)
itemcount = GetMenuItemCount(hMenu)


With mii
.cbSize = Len(mii)
.fMask =&H40
For c = 0 To itemcount - 1
     .dwTypeData = Space(256)
     .cch = 256
  retval =GetMenuItemInfoA(hMenu, c, 1, mii)
 Debug.Print Left$(.dwTypeData,.cch)

Next   

----------SYSMENU EXTRACT STRING---------

hMenu=GetMenu(hwnd) 

MenuCount = GetMenuItemCount(hMenu)
If MenuCount < 0 Then
Exit Sub
End If

MII.cbSize = Len(MII)
MII.fMask = MIIM_TYPE
MII.fType = MFT_STRING

For ForLoopCounter = 0 To MenuCount - 1
MII.dwTypeData = vbNullString
MII.cch = Len(MII.dwTypeData)
GetMenuItemInfo(hMenu, ForLoopCounter, True, MII)

MII.dwTypeData = Space(MII.cch + 1)
MII.cch = Len(MII.dwTypeData)

GetMenuItemInfo(hMenu, ForLoopCounter, True, MII)

StopChar = Right(MII.dwTypeData, 1) Debug.Print Left(MII.dwTypeData, InStr(1, MII.dwTypeData, StopChar) - 1) 

Next

تغییر اطلاعات درباره یک آیتم منو

SetMenuItemInfoA hmenu,item,fByPositon, lpmii

آرگومان سوم True باشد آرگومان دوم ایندکس است از صفر شروع می شود و تعداد کل منهای یک .. تعداد کل با تابع GetMenuItemCount بدست می آید و آرگومان آخر اطلاعات که در استراکچری بانام MENUITEMINFOA ذخیره شده یا می شود .

SetMenuItemBitmaps hMenu,uPosition, uFlags,hBitmapUnchecked,hBitmapChecked

 BITMAP مناسب را در کنار آیتم منو نمایش می دهد. ( فقط فایل BITMAP )  ، در مثال زیر کنار آیتم 5 ( ایندکس آیتم از صفر شروع میشود ) یک BITMAP قرار می دهد.

setmenuitembitmaps hSysMenu, 5, &H400, loadimage(image_Bitamp),loadimage(image_Bitamp)

اضافه کردن یک آیتم جدید به آیتم منوها اگر اضافه شود دیگر آیتم ها به پائین منتقل می شوند.

InsertMenuA hMenu,uPosition,uFlags,uIDNewItem,lpNewItem  ' Lib User32

uFlags +  

: MF_BYCOMMAND OR MF_BITMAP

در زیر اشاره شده استفاده از BITMAP بعنوان آیتم منو ، پارامتر lpNewItem حاوی هندلی به BITMAP است 

MF_BITMAP 0x00000004L

Uses a bitmap as the menu item. The lpNewItem parameter contains a handle to the bitmap.

پارامتر uFlags باید با یکی ازمقادیر زیر باشد.

MF_GRAYED=&H1 غیر فعال کردن منو و خاکستری کردن آن
MF_DISABLED=&H2 غیرفعال کردن منو
MF_SEPARATOR=&H800
MF_STRING=&H0 '  lpNewItem =your text

lpNewItem بستگی به این دارد که پارامتر uFlags شامل Flag ( پرچم )MF_BITMAP, MF_OWNERDRAW یا MF_STRING باشد

flag های زیر با هم نمی توانند استفاده شوند :

• MF_BYCOMMAND and MF_BYPOSITION
• MF_DISABLED, MF_ENABLED, and MF_GRAYED
• MF_BITMAP, MF_STRING, MF_OWNERDRAW, and MF_SEPARATOR
• MF_MENUBARBREAK and MF_MENUBREAK
• MF_CHECKED and MF_UNCHECKED

CONST SC_CLOSE = 61536

CONST MF_BYCOMMAND = 0

hMenu=GetSystemMenu(hWnd, FALSE )

IF hMenu > 0 THEN

DeleteMenu hMenu,SC_CLOSE ,MF_BYCOMMAND DrawMenuBar hWnd

END IF 

InsertMenuA hMenu,SC_CLOSE, MF_BYCOMMAND,SC_CLOSE, "&Close~tAlt+F4" ) 

----------------XXXXXXX------------------

InsertMenuA hmenu, -1, MF_STRING Or MF_BYPOSITION,uidFirstCmd, "SimpleShlExt Test Item"

SetMenuItemBitmaps hmenu, uidFirstCmd, MF_BITMAP Or MF_BYCOMMAND,hBitmap,hBitmap

----------------------------------

Public Type WNDCLASSEXA
cbSize As Long
style As Long
'lpfnWndProc
hIcon As Long 'A handle to the class icon
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
hIconSm As Long 'A handle to a small 'icon that is associated with the window 'class.
End Type

VK_F1=&H70
WM_KWYDOWN=&H100

'Lib user32
SetClassLongPtrA hWnd,nIndex,dwNewLong

nIndex :
GCLP_HICONSM=-34 'small icon GCL_STYLE=-26
GCLP_WNDPROC=-24
GCLP_HICON=-14
GCLP_HCURSOR=-12
GCLP_ HBRBACKGROUND=-10

WndProc :
Select Case uMsg
Case WM_KEYDOWN
Select Case wParam
Case VK_F1
newBrush=CreatePatternBrush(newBMP)

oldBrush=SetClassLongPtrA(hwnd, GCLP_HBRBACKGROUND,newBrush)
DeleteObject oldBrush
InvalidateRect hwnd,Null,True
End Select
End Select
DefWindowProcA hwnd,uMsg,wParam,lParam

ساخت دیالوگ باکس Open که به کاربر اجازه انتخاب Drive ، Directory و نام یک فایل یا مجموعه ای از فایل هایی که باز می شوند را می دهند.

'Lib Comdlg32  

 GetOpenFileNameA LPOPENFILENAMEA 

البته اول بایدپارامتر LPOPENFILENAMEA تنظیم شود در داکیومنت آفیس بدان اشاره شده مطالعه کنید.

ساخت دیالوگ باکس SAVE که به کاربر اجازه انتخاب درایو ، دایرکتوری و فایل یا مجموعه ای از فایل هایی که SAVE می شوند را می دهد.

GetSaveFileNameA LPOPENFILENAMEA

------------------CREATEFILEA---------------

'C#
hVolume = CreateFile(@"\\.\A:", GENERIC_READ,
                                FILE_SHARE_READ | FILE_SHARE_WRITE, IntPtr.Zero,
                                OPEN_EXISTING, 0, IntPtr.Zero);

hCom = CreateFile(
    "COM1",
    GENERIC_READ | GENERIC_WRITE,
    0,
    NULL,
    OPEN_EXISTING,
    0,
    NULL
);

GetCommState hFile,lpDCB 'Lib Kernel32

Public Type DCB
DCBlength As Long ' Len(DCB)
BaudRate As Long  '9600
fParity As Long  'True
End Type

Public Declare Ptrsafe Function SetCommState Lib "Kernel32" (Byval hFile As LongPtr,Byval lpDCB As DCB)

CloseHandle  hFile  ' Lib  kernel32

############

Public Declare Ptrsafe Function SetCommState Lib "Kernel32" (Byval hFile As LongPtr,Byval lpDCB As DCB)

CreateFile Comm
Sleep 1000
'After CreateFileA Use SetupComm
'to set the communications parameters 'for the device.
'SetupCommhFile,dwInQueue,dwOutQueue
SetupComm Comm, 128, 128
DCB. DCBlength=Len(DCB)
GetCommState Comm, dcb

dcb.BaudRate = 9600
dcb.ByteSize = 8
dcb.fBinary = TRUE
dcb.fParity = FALSE
dcb.Parity = NOPARITY
dcb.StopBits = ONESTOPBIT
dcb.fAbortOnError = TRUE
SetCommState Comm, dcb

'Set the event mask
'SetCommMask hFile,dwEvtMask 'kernel32
'EV_RXCHAR=&H1: A character was 'received and placed in the input buffer

SetCommMask Comm, EV_RXCHAR
DWORD dwMask = EV_RXCHAR

Sleep 1000
'Send the message to Module
WriteFile Comm,msg,len(msg),0, NULL

'Wait Response from module
'WaitCommEvent 'hFile,lpEvtMask,lpOverlapped
WaitCommEvent Comm, &dwMask, NULL

sBuffer=String(128,"")
ReadFile Comm, sBuffer,8,0, NULL

انتخاب رنگ استفاده از ChooseColor

ChooseColor : ms646912(v=vs.85)

DLL : Comdlg32.dll

LIB is Required 

If Use 64 bit windowse , before Function use PtrSafe

در لینک زیر نحوه استفاده و فراخوانی دیالوگ باکس ها مثل رنگ ، فونت ، پرینت بیان شده و می توانید به نحو احسنت و دلخواه فیض ببرید DLL آنهم در بالا گفته شده حتما در فراخوانی باید از LIB استفاده شود مثل 

Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

توابع Api ویندوز را با همان نام و حروف کوچک و بزرگش فراخوانی کنید فرضا در GetWindow اگر getWindow تایپ کنید خطا می دهد. برای ویندوز 64 بیت قبل از Function از PtrSafe استفاده کنید و بعضی از آرگومانها مثل hWnd هم باید بجای دیتا تایپ Long از LongPtr استفاده کرد.

using-common-dialog-boxes

CHOOSECOLOR cc ' common dialog box structure static COLORREF acrCustClr[16] ' array of custom colors

HWND hwnd 'owner window

HBRUSH hbrush 'brush handle

static DWORD rgbCurrent 'initial color selectionInitialize CHOOSECOLOR ZeroMemory(&cc, sizeof(cc)); cc.lStructSize = sizeof(cc); cc.hwndOwner = hwnd; cc.lpCustColors = (LPDWORD) acrCustClr; cc.rgbResult = rgbCurrent; cc.Flags = CC_FULLOPEN | CC_RGBINIT;

See the link >>>>> choosecolora

typedef struct tagCHOOSECOLORA { 

 DWORD lStructSize; 

 HWND hwndOwner; 

 HWND hInstance; 

 COLORREF rgbResult; 

 COLORREF *lpCustColors; 

 DWORD Flags; 

 LPARAM lCustData; 

 LPCCHOOKPROC lpfnHook; 

 LPCSTR lpTemplateName; 

 LPEDITMENU lpEditInfo; } 

CHOOSECOLORA, *LPCHOOSECOLORA;

در لینک کاربرد هر کدام مفصل بیان شده که بعضی به کار کنونی ما ربط پیدا می نماید.

در بالا اول استراکچری تعریف شده که مقادیری را در خودش نگه می دارد 

Pubic Type ChooseColor

#if win64 Then

lStructSize As LongPtr

hwndOwner As LongPtr

lpCustColors() As LongPtr

rgbResult As LongPtr

Flags As LongPtr

#Else

lStructSize As Long

hwndOwner As Long

lpCustColors() As Long

rgbResult As Long

Flags As Long

#End if

End Type

 تابعی به اسم dlgColor تعریف شده و از نوع Long ... اگر رنگ دیفالتی قرار است تعریف شود در تابع می توانید بکار ببرید مثل Oprional iDefault As Long 

Dim cc As ChooseColor

Dim lRet As Long

Static CustomColors(16) As Long

'If yoy want to use

CustomColors(1)=RGB(255,255,255)

With cc

.lstructSize=LenB(cc)

.hwndOwner=Application.hWndAccessApp

.flags=

.lpCustcolors=VarPtr(CustomColors(0))

End With

lRet=ChooseColor(cc)

If lRet=0 Then '  کنسل توسط کاربر

dlgColor=RGB(255,255,255) ' سفید

Else

dlgColor=cc.rgbResult

End If 

اگر rgbResult صفر یا CC_RGBINIT تنظیم نشده باشد رنگ انتخاب شده اصلی مشکی است . اگر کاربر باتن OK را بفشارد rgbResult انتخاب کاربر خواهد بود.از RGB ماکرو استفاده کنید.

برای flags در استراکچر بالا از CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT استفاده بنمائید که باز کردن دیالوگ باکس هم درونش وجود دارد.

lpCustColors نشانگری است به آرایه (16) ای که حاوی مقادیر قرمز سبز آبی  برای جعبه رنگ در دیالوگ باکس است .اگر کاربر در این رنگ ها  تغییراتی بدهد سیستم آرایه را به مقادیر جدیدی به روز رسانی خواهد کرد برای نگهداری این به روز رسانی و  استفاده از آن در تابع بایستی حافظه Static را برای این آرایه تخصیص بدهید مثل Static CustomColors(16) As Long . برای ساختن COLORREF از ماکرو RGB استفاده بنمائید. 

لینک زیر هوک کردن دیالوگ باکس البته پیشنهاد نمیشود و درون آن پنجره هم CHILD یا زیر پنجره هایی وجود دارد و توصیه شده از GETPARENT استفاده بنمائید.

 چرخش در زنجیره ی هوک  commdlg-lpofnhookproc

Lpofnhookproc; UINT_PTR Lpofnhookproc( HWND unnamedParam1, UINT unnamedParam2, WPARAM unnamedParam3, LPARAM unnamedParam4 )

رویه HOOK میتواند تابع PostMessage را برای ارسال پیام 

WM_COMMAND با مقدار IDCANCEL به رویه دیالوگ باکس فرابخواند.ارسال IDCANCEK این پنجره را می بندد و باعث می شود تابع FALSE را برگرداند.

اگر پیام WM_CTLCOLORDLG به پنجره ارسال شود و همچین پیامی داشته باشد آن بایستی یک هندل BRUSH معتبری برای رنگ کردن  پیش زمینه دیالوگ باکس را برگشت دهد. 

WM_CTLCOLORDLG : 

wParam

A handle to the device context for the dialog box.

lParam

A handle to the dialog box.

Public Function DlgProc(ByVal hwnd As longPtr,ByVal Umsg As Long, ByVal wParam As LongPtr,Byval lParam As LongPtr)

Select Case Umsg
 Case WM_INITDIALOG
SetDlgItemText(hwnd, IDC_FROM, "Start address")
SetDlgItemText(hwnd, IDC_TO, "Destination address")
Case WM_COMMAND
Select Case Left(wparam, )

.

End Select
Case WM_CTLCOLORDLG
.
End Select
.
End Select

DlgProc=False
End Function

Public WindowProc(ByVal hWindow As LongPtr,ByVal uMsg As Long ,ByVal wParam As LongPtr,ByVal lParam As LongPtr)
Select Case uMsg
case WM_CLOSE DestroyWindow(hWindow)
case WM_DESTROY
PostQuitMessage(0)
End Select
Ret=DefWindowProc(hWindow, uMsg, wParam, lParam)
WindowProc=False
End Function

یک اپلیکیشن می تواند قبل از بستن پنجره پیامی را توسط کامپیوتر ارسال کند ( Prompt ) ، توسط فرآیند پیام WM_CLOSE و فراخوانی تابع DestroyWindow تنها اگر کاربر انتخاب را تائید کند. (یعنی اگر کاربر IDCANCEL را بفشارد تابع DestroyWindow با پیام WM_CLOSE که به پنجره می فرستد منجر به بستن آن خواهد شد.)

بصورت دیفالت تابع DefWindowProc تابع DestroyWindow برای بستن پنجره فرا می خواند ( Call ) ... برای تایع بالا گفته شده

Public lpPrevWindProc As LongPtr

GWL_WNDPROC=(-4)

در HOOK برای DLG می توان از   SetWindowLongPtr   استفاده کرد و به fnWindProc آدرس داد و در آنجا پیام هایی را به پنجره ارسال کرد.

Function fnWindProcWrapper(ByVal hWnd As LongPtr, _ ByVal uMessage As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) _ As Long
' [Add your code here]
CallWindowProc lpPrevWindProc, hWnd, uMessage, wParam, lParam

End Function 

پنجره اکسس در اینجا hook شده ولی توصیه نمیشود چون اگر پنجره ای دیگر باز شود اگر نتوانید هندل آنها را بدست آورید به آنها ارسال خواهد شد و ممکن است سیستم هنگ کند و مجبور به End Process از پنجره Task Manager شوید.

Function HookWindProc()

MsgBox "Hook WinProc"

lpPrevWindProc = SetWindowLongPtr(Application.hWndAccessApp, GWL_WNDPROC, AddressOf fnWindProc)

End Function

مثال دیگر از WINDOWPROC : 

تابع زیر در ویندوز 32 بیت برای 64 باید از دیتا تایپ LONGPTR یا LONGLONG و قبل از FUNCTION نیز PTRSAFE بکار برده شود در نظر داشته باشید استعمال این توابع توصیه نمی شود چون واقعا UNSAFE می شود.

Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Public pVBProc As Long
' pointer to Window procedure
' The above variable defaults to 0 automatically

Public Function WindowProc (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Call the default window procedure and return its result.
WindowProc = (hWnd, uMsg, wParam, lParam)
End Function
کد زیر را در هر کجا که مایل هستید قرار دهید

Dim retval As Long
' return value
If pVBProc = 0 Then
pVBProc = SetWindowLong(Form1.hWnd, GWL_WNDPROC,AddressOf WindowProc)
Else
retval=SetWindowLong(Form1.hWnd, GWL_WNDPROC, pVBProc)
pVBProc = 0
End If 

گرفتن HANDLE پنجره هایی که داخل پنجره اصلی قرار دارند

Declare Function EnumChildWindows Lib "user32" (byval hWndParent as Long, byval lpEnumFunc as Long, byval lParam as Long) as Long
Declare Function GetParent Lib "user32" (byval hwnd as Long) as Long


public Function VB_WndEnumProc(byval hwnd as Long, byval lParam as Long) as Long

'onerror resume next

Debug.Print hwnd & ";" & lParam
'Loop
WndEnumProc = 1

End Function

CENTER MESSAGEBOX :

البته ممکن است کد زیر خطای نوشتاری داشته باشد ولی در کل سنتر کردن بدین نحو است که به VBA ترجمه شده ... البته فرم باید در حالت POPUP باشد. در صورت تست تصویر مربوطه در زیر پست قرار داده میشود .

Public hhk As Long
Private Type Rect
x As long
y As Long
End Type

Public Function CBTMessageBox(ByVal hwnd As Long,ByVal lpText As String,ByVal lpCaption As String,uType As Lonh)
hhk=SetWindowsHookEx(WH_CBT, AddressOf CBTProc,0, GetCurrentThreadId())
CBTMessageBox=MessageBox(hwnd, lpText,lpCaption,uType)
End Function

Public Function CBTProc(ByVal nCode As Long,ByVal wParam As Long,lParam As Long)

Dim hParentWnd As Long
Dim hChildWnd As Long
'msgbox is "child"
Dim rParent,rChild,rDesktop As Rect
Dim pCenter, pStart As POINTAPI
Dim nWidth, nHeight As Long

'window handle is wParam

if nCode = HCBT_ACTIVATE Then
'set window handles
hParentWnd = GetForegroundWindow()
hChildWnd = wParam

if ((hParentWnd <> 0) And (hChildWnd <> 0) And (GetWindowRect(GetDesktopWindow(), &rDesktop) <>0) And (GetWindowRect(hParentWnd, &rParent) <>0) And (GetWindowRect(hChildWnd, &rChild) <>))  Then


'calculate message box dimensions nWidth = (rChild.right - rChild.left) nHeight = (rChild.bottom - rChild.top) 'calculate parent window center point pCenter.x = rParent.left+((rParent.right - rParent.left)/2)
pCenter.y = rParent.top+((rParent.bottom - rParent.top)/2)
'calculate message box starting point pStart.x = (pCenter.x - (nWidth/2)) pStart.y = (pCenter.y - (nHeight/2))


'adjust if message box is off desktop if(pStart.x < 0) Then pStart.x = 0
if(pStart.y < 0) ThenpStart.y = 0
if(pStart.x + nWidth > rDesktop.right) Then
pStart.x = rDesktop.right - nWidth
End If
if(pStart.y + nHeight > rDesktop.bottom) Then
pStart.y = rDesktop.bottom - nHeight
End If

'move message box MoveWindow(hChildWnd,pStart.x, pStart.y,nWidth,nHeight,FALSE)
'exit CBT hook UnhookWindowsHookEx(hhk)

Else
CallNextHookEx(hhk, nCode, wParam, lParam)
End if
End if
CBTProc=False
End Function

متد Docmd.RunCommand

انتقال کرسر به رکورد بعدی 

DoCmd.RunCommand acCmdRecordsGoToNext

acCmdCut

acCmdUndo

acCmdCopy

acCmdPase

acCmdZoom150

acCmdWindowHide

acCmdSelectReord  ' SingleForm

acCmdSelectForm

acCmdSelectReport

کاربرد مثال زیر برای به حداکثر یا به حداقل رساندن  سایز پنجره اکسس یا برگشت به وضعیت قبلی است.




Sub WinSize(strSize As String)

  Select Case strSize

    Case "Max"

      DoCmd.RunCommand acCmdAppMaximize

    Case "Min"

      DoCmd.RunCommand acCmdAppMinimize

    Case "Rest"

      DoCmd.RunCommand acCmdAppRestore

    Case Else

      MsgBox strSize & " is not a valid argument"

  End Select




End Sub

برای انتخاب آبجکت مورد نظر مثل فرم یا جدول و مخفی کردن آن اول از Docmd.SelectObject و تعریف آبجکت موردنظر و سپس از Docmd.RunCommand acCmdWindowHide استفاده میشود و برای نمایش آن آبجکت فقط از SelectObject استفاده می شود.

انتخاب و حذف رکورد :

Docmd.SetWarnings False

DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdDeleteRecord

Docmd.SetWarnings True

انتقال به رکورد بعدی با : 

Docmd.GotoRecord

بستن تمام پنجره های باز   acCmdCloseAll         

بستن دیتابیسacCmdCloseDatabase  

بستن فرم جاریacCmdCloseWindow      

 کامپکت کردن دیتابیس اما نه دیتابیس باز !!!

  acCmdCompactDatabase

        acCmdFind بازکردن پنجره جستجو

استفاده از متد Docmd.Restore نیز برای برگرداندن سایز پنجره Max یا Min شده به سایز قبلی است فرضا زمانیکه پنجره اکسس را Hide می کنید با تابع API و گزارشی را مینیمایز می کنید برای برگرداندن به حالت قبلی خودش که قابل مشاهده بوده این دستور را Fire کنید.

Hide Application.hWndAccessApp : showwindow

استفاده از متد hWndAccrssApp برای تعیین هندل تخصیصی توسط ویندوز به پنجره اصلی Access که برای استفاده از تابع بالا حتما برای مقدار دهی  آرگومان hWnd از این متد استفاده بنمائید.

تغییر Cursor در کنترل

CommandButton.CursorOnHover property

تغییرشکل Cursor زمانیکه نشانگر روی باتن نگه داشته میشود و دو مقدار دارد صفر دیفالت و یک HyperlinkHand بصورت دست نشان داده میشود.

ازتابع API هم می توان استفاده کرد در MouseMove کنترل استفاده کرد و در MouseMove دیتیل هم برابر مقدار قبلیش تعیین کرد 

LoadCursor loadcursora

Screen.MousePointer هم هست می توان در MouseMove کنترل گفت اگر داخل x و y بود اعمال شود و در MouseMove دیتیل هم Reset شود.

Screen.MousePointer = 11 'HourGlass

Same as Docmd.HourGlass

Textbox.DisplayAsHyperlink نشانگر را به شکل دست نمایش میدهد.

vba/api/access.textbox.displayashyperlink

 "your text <a href = """ & url & """>" & url & "</a>"

Ribbon

 tabs

"TabHomeAccess"

 tabs

ribbon

backstage   : button & Tab

  "FileSaveAsCurrentFileFormat"

  "FileOpen" visible="false"

  "FileCloseDatabase"

  "TabInfo"

  "FileSave"

  "TabPrint"

  "TabHelp"

  "ApplicationOptionsDialog"

DoCmd.ShowToolbar "Ribbon", acToolbarNo

    DoCmd.NavigateTo("acNavigationCategoryObjectType")
    'select the navigation pange
    'hide the selected object
    DoCmd.RunCommand(acCmdWindowHide)




Hide کردن تب Home اگر Group داخلش باشه Group باید اضافه شده و Disable شود 

Public Function CustomRibbon()
    Dim customXML As String

    customXML = "<customUI xmlns=""http://schemas.microsoft.com/office" _
                & "/2009/07/customui"">" _
                & "  <ribbon startFromScratch=""false"">" _
                & "    <tabs>" _
                & "      <tab idMso=""TabHomeAccess"" visible=""false"" />" _
                & "    </tabs>" _
                & "  </ribbon>" _
                & "</customUI>"

    Application.LoadCustomUI "HideHome", customXML
End Function

Windows management instrumentations

"winmgmts:"

win32-networkadapterconfiguration

 IPENABLED دارد که دیتا تایپ آن BOOLEAN است و میشود IPADDRESS های فعال که دیتا تایپ String دارد و باید بعد از استفاده از متد ExecutedQuery آبجکت WMI در آن لوپ زده شود.

Set objQuery = objWMI.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")

win32-process

کلاس Win32_Pocess فرآیندهایی که در سیستم کاری وجود دارد. متد Terminate دارد که می توانید به اجرای فرآیند خاتمه دهید شامل آیتم هایی است که در لینک مشاهده کنید یکی از آنها Name است می توانید در Select از آن استفاده کنید و فرضا مسیر Excel.Exe را در آن بگذارید و بعد از Set کردن Variable به آبجکت آنرا Terminate نمائید.

Set objQuery = objWMI.ExecQuery("Select * from Win32_Process Where Name= .....")

With objQuery

.Terminate

End With 

win32-logicaldisk

کلاس Win32_logicaldisk شامل اطلاعاتی درباره درایوها است و آیتم هایی دارد مثل گرفتن سریال نامبر

VolumeSerialNumber

win32-diskdrive

کلاس Win32_Diskdrive شامل اطلاعات درایوها ست و آیتم هایی دارد مثل SerialNumber که لوپ زده میشود و مقدار را بدست می آوریم.

Set ColItems = objWMIService.ExecQuery( _ "SELECT * FROM Win32_DiskDrive") Dim i As Integer 

'For Each ObjItem In ColItems

win32-networkconnection

Get MACAddress win32-networkadapter

Get MACAddress win32-networkadapterconfiguration

IPEnabled / IPAddress  / MACAddress

Win32_OperatingSystem

SerialNumber

Method : Reboot ( Shut & Restart )

API : 

nf-fileapi-getvolumeinformationa

----------------------------------------

Get serial number for hard disks

wmic diskdrive get serialnumber

Example:

c:\>wmic diskdrive get serialnumber
SerialNumber
FR3AG13032430BC13S

Get serial number for mother boards

wmic baseboard get serialnumber

See also get-disk-drive-information-in-windows-10-with-this-command/amp/

MotherBoard  command/Windows/wmic/en-us/wmicBASEBOARD

See Also to minimze or maximize window of application win32/shell/shell-shellexecute

ShellExecute

Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run "cmd /c dir > test.txt"


'Create shell object
Dim objShell
Set objShell = CreateObject("WScript.Shell")
'call Notepad program
objShell.Run "notepad.exe",1,true
MsgBox "I know what you wrote :-)"

"Wscript.Shell"  SendKeys  2b56c24affdd

Wscript.Shell

Run

SpecialFolders("strfoldername")

CreateShortCut

Save

strFolderName : One of the following special folders 
                   (not all are available to all flavors of Windows)
      AllUsersDesktop
      AllUsersStartMenu
      AllUsersPrograms
      AllUsersStartup
      Desktop
      Favorites
      Fonts
      MyDocuments
      NetHood
      PrintHood
      Programs
      Recent
      SendTo
      StartMenu
      Startup
      Templates

ShutDown Message " 

Shell "Cmd /c Shutdown -s -t "

shutdown -L

You cannot hide the cmd window with any batch file command. You can launch the batch file from a vbscript and have it run as a background process which hides the cmd window. You could put powershell -window hidden -command "" in your script

"wmic diskdrive get model,serialNumber,index,media > C:\path\to\text.txt"

--------------

I made log table, I have the back-end database on a server, and a few front-end files in the office, and i want to log all the users who access the back-end.

I used the Environ function, it provides me the computer name / user name and anything else i need, but it doesn't show the IP address. The functions I made are working, all I need is to get the IP address..

'ExecQuery

'Win32_NetworkAdapterConfiguration Where

'IPEnabled = True

For Each itm In myobj

  getMyIP = itm.IPAddress(0)

  Exit Function

Next

The "wscript.Network" object

Provides access to the shared resources on the network to which your computer is connected.

Properties :
.UserName
.ComputerName

Methods :
.SetDefaultPrinter
'SetDefaultPrinter "\\research\library1"
.AddWindowsPrinterConnectiob
'AddWindowsPrinterConnection(PrinterPath)
.RwmoveNetworkDrive


GetUser=CreateObject("wscript.Network").UserName

------------

getmac /v /fo csv > T:\macaddresses.csv

"HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\File MRU\Quick Access Display", iShow, "REG_DWORD"

iShow=0 Or 1

'USysRibbon

<backstage>
<tabidMso ="TabRecent" visible="false"/>
</backstage>

اضافه کردن All به کمبو باکس

Sub GetComboBoxList()
Dim strList, strSQL As String

strList = "<All>;"
With cboState
     With CurrentDb.OpenRecordset(.RowSource)
        Do Until .EOF
           strList = strList & !State & ";"
           .MoveNext
        Loop
End With
.RowSourceType = "Value List"
.RowSource = strList
End With
End Sub

در کد بالا از پراپرتی RowSourceType آبجکت کمبو باکس  برای باز شدن در RecordSet استفاده شده ، در رکوردست لوپ زده و گفته تا زمانیکه به انتهای فایل نرسیده All و مقادیر داخل فیلد State را در StrList موقتا ذخیره کند ( چون پابلیک تعریف نشده  فقط در همین رویه استفاده می شود و فرمان که تمام شد از بین میرود) و در آخر RowSource  شده StrList 

البته با union query هم می توان All را با آیتم های کمبو باکس همراه کرد ، fieldtobedataforcombo نام فیلدی که رکوردها یش باید در کمبو نمایش داده شوند.

Cbo1.RowSource="

Select distinct fieldtobedataforcombo from table1 

Union

Select "ALL" 

Group by fieldtobedataforcombo

Order by fieldtobedataforcombo" 

Cbo1.RowSourceType="Table/Query"

CurrentDb.Properties

Name 

Connect 

Transactions 

Updatable

CollatingOrder

QueryTimeout

Version

RecordsAffected

ReplicaID

DesignMasterID

Connection

ANSIQuery Mode 

Themed Form Controls

AccessVersion

Build

ProjVer

StartUpForm

StartUpShowDBWindow

StartUpShowStatusBar

AllowShortcutMenus

AllowFullMenus

AllowBuiltInToolbars

AllowToolbarChanges

AllowSpecialKeys

UseAppIconForFrmRpt

Track Name AutoCorrect Info

Perform Name AutoCorrect 

AppTitle

AppIcon

تنظیم پراپرتی های موجود در دیتابیس با کد زیر که از سایت خارجی استخراج شده اگر درست کار کند.

FunctionName(Name,Type,Value) As Boolean


On Error Resume Next

Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) =varPropValue
ChangeProperty = True


If err=3270 Then ' Not Found
Set prp=dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Else
ChangeProperty = False
Exit Function
End If
End Function

Application.RefreshTitleBar

2003 :

You can set the StartupShowDBWindow property to False to hide the Database window so the user can't see the tables, queries, macros, and modules within your database

Application.SetOption : 

Application.SetOption "Selection Behavior", 1

set-options-from-visual-basic

SendIcon : 

hWnd = Application.hWndAccessApp

    lcon = ExtractIcon(0, sIcon, 0)

    If lcon > 1 Then

        SendMessage(hWnd, WM_SETICON, True, Icon)

        SendMessage(hWnd, WM_SETICON, False, lIcon)

    End If

محدود کردن تعداد رکورد در فرم کانتینیوس

:Oncurrent

Me.AllowAdditions = (Me.Recordset.RecordCount <20)

تا زمانیکه پراپرتی RecordCount در آبجکت رکوردست برابر 19 است  پراپرتی AllowAdditions فرم True است و شما اجازه اضافه کردن به آن را دارید درصورتیکه تعداد رکوردها بیست شد پراپرتی به False تنظیم و از اضافه کردن جلوگیری خواهد نمود. 

Report Properties رکورد خالی

در گزارش برای ایجاد ردیف دو نوع Running Sum وجود دارد یکی OverAll بصورت کلی  و دیگری OverGroup  جمع در هر گروه و اگر مقدار گروه عوض شد دوباره از یک شروع میشود 

You can create a text box with a running sum over group and control source of =1. Name the text box txtGrpRunSum. The text box does not need to be visible.

MoveLayout: if False, prints on top of what was printed last;

NextRecord: if False, prints the same record again;

PrintSection: if False, doesn't print any data.

سه تا از پراپرتی های گزارش زمان استفاده از پراپرتی NextRecord در Detail_OnPrint اگر False باشد همان رکورد را پرینت میکند در صفحه ( یعنی رکورد تکرار میشود ) . اگر PrintSection نیز False باشد هیچ داده ای پرینت نمی شود.

در PageHeader_OnFormat می توان متغیری را تعریف  و مقدار آنرا False کنیدبرای NextRecord. و متغیری هم برای شمارش لاین ها ولی در اینجا مقدارش به صفر تنظیم و در OnPrint دیتیل اگر PrintCount  برابر یک بود لاین هم افزایشی میشود.

متغیرها باید در خارج از Event تعریف شده باشند 

مثال زیر نشان می دهد چگونه می توان از پراپرتی PrintCount استفاده نمود تا مطمئن شوید مقدار کنترل OrderAmount فقط یکبار به running total اضافه شده.

Running Total می تواند متغیر public باشد یا نام یک کنترل unbound که هر بار که section پرینت میشود به آن اضافه شود 

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)

If PrintCount = 1 Then 

RunningTotal = RunningTotal + OrderAmount

End If

End Sub

هر بار که OnPrint  اجرا میشود PrintCount نیز افزایشی میشود و همانطور که سکشن بعدی پرینت می شود ( در صفحه منظور نه ارسال به پرینتر !!! ) ، اکسس پراپرتی PrintCount را به 0 بر می گرداند یا باصطلاح Reset میشود.

نمونه ای از بکارگیری NextRecord و PrintSection اگر دومی استفاده نشود چه اتفاقی خواهد افتاد ؟ 

در زیر تعریف شده که در هر پیج 22 لاین نمایش داده شود و بقیه به پیج های بعدی منتقل شود.

متغیر MaxL تعریف شده یعنی حداکثر لاین در Page 

متغیر C تعریف شده یعنی Count کوئری که در گزارش فیلتر شده فرضا از OpenReport در فرم Launch شده.و در رویداد Open گزارش قرار داده شده.

OnPrint:

If PrintCount=1 Then L=L+1

Option Compare Database

Option Explicit

Const MaxL As Integer = 22 'Lines

Private C As Integer 'Total

Private Sub Report_Open(Cancel As Integer) 

' get total record count

C= DCount("*", "qryData") 

End Sub

متغیری باید تعریف کرد که در هر بار مقداری افزایشی به آن نسبت داده شود مثل L

فرضا در کوئری 28 رکورد نمایش داده می شود در حالیکه گفته شده  تنها 22 رکورد ( MaxL ) در هر Page باشد.

زمانیکه L Mod 22 برابر صفر شود و اگر L مخالف RLines شود PageBreak که در سکشن دیتیل قرار داده True  شده و بقیه رکوردها به صفحه بعد میرود.

محاسبه تعداد کلی خطوط : 

'calculate the total number of lines 'required.

RLines = ((C \ L) + 1) * L

زمان نمایش رکوردهای تکرار شده تا پایان صفحه که پر میشود می توانید پراپرتی ForeColor کنترل ها را به VbWhite تغییر داد.

برای نمایش تعداد 20 رکورد از هر گروه در گزارش می توانید شرطی در کوئری بگذارید.

سه فیلد State ، Town ، Pop از جدول MyTable را انتخاب کرده البته 20 رکورد از هر State  در گروپ گزارش می آید.

SELECT  State, 

        Town, 

        Pop 

FROM    MyTable 

WHERE   Pop In 

        (SELECT Top 20 Pop 

        FROM    MyTable As T2 

        WHERE   T2.State = MyTable.State 

        ORDER BY Pop Desc

ImageProcess Object ( تغییرات روی تصویر )

پست زیر درباره  مواردی که می توان روی Image انجام داد مثل تغییر سایز ( Scale ) یا Rotation و  Resolusion

ImageProcess : 

مدیریت زنجیره ی Filter . آبجکت ImageProcess می تواند با استفاده از  WIA.ImageProcess ساخته شود.

ImageProcess.FilterInfos Property : 

مجموعه ای از تمام فیلترهای موجود را فراخوانی میکند . هر عکسی شامل یکسری داده است مثل ارتفاع ، رزلوشن که اینها در زنجیره فیلتر جمع آوری یا Collect شده اند. شما به اینها دسترسی پیدا می کنید و هر کدام که ReadOnly  نباشد می توانید تغییر و ذخیره کنید.

برای لود یک فایل یا ذخیره از آبجکت ImageFile استفاده میشود و برای ساختش از عبارت WIA.ImageFile داخل CreateObject و تنظیم آن به یک Variable استفاده میشود یا می توانید از رفرنس هایی که در Vba وجود دارد تیک آنرا بزنید و دیگر از CreateObject استفاده کنید.

Set Img=CreateObject("WIA.ImageFile")

Img.LoadFile(path & filename)

Method : LoadFile , SaveFile 

آبجکت ImageFile یک ظرف است که Image هایی را که به کامپیوتر ارسال می کنید در آن نگهداری میشود و دارای دو متد بالاست و پراپرتی هایی از جمله Width و Height و ....

آبجکت ImageProcess حاوی FilterInfos مجموعه ای از تمام فیلترهای موجود ,  Filters مجموعه فیلترهایی که باید به یک ImageFile    اعمال شود .و  متد Apply برای اقدام و انجام.

پس با توجه به یادداشت بالا می بایست از Add استفاده کنیم برای اضافه کردن FilterInfos به مجموعه Filters.

Set IP=CreateObject("WIA.ImageProcess")

'Assign Filters

'Appends or inserts a new Filter of the 'specified FilterID into a Filters collection.

'Method Add ( اضافه یا درج فیلتر جدید داخل مجموعه فیلتر)

IP.Filters.Add IP.FilterInfos("Scale").FilterID

'Retrieves the FilterID (FilterInfo) for this filter.

IP.Filters(1).Properties("MaximumWidth")=

IP.Filters(1).Properties("MaximumHeigth")=

'Filter APPLY On Inage

Set Img=IP.Apply(Img)

Img.SaveFile(.....)

wingdi-createcompatiblebitmap

.

Label Behind The Button

در رویداد MouseDown کنترل ..... cmdClose 

Me.cmdClose.BackStyle = 0 'transparent

در رویداد MouseUp کنترل ...... cmdClose

  Me.cmdClose.BackStyle = 1 'Normal

.

کامند باتن Rectangle و MouseMove

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

تغییر رنگ حروف تک به تک بصورت رندوم فقط در لیبل

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

مثالی از رویداد تایمر فرم

فرض کنید باتنی دارید که بعد از تایپ حروفی در تکست باکس کار فیلتر یا جستجو را انجام داده و در صورت یافتن یا ... پیامی را در لیبلی که Visible نیست نمایان میکند و مدت معینی با TimeInterval لیبل به حالت چشمک زن در می آید و بعد از فوکس کردن به تکست باکس دوباره لیبل Hide میشود.

در رویداد کلیک باتن TimeInterval را تنظیم کنید فرضا به 300 میلی ثانیه .... در ضمن نام آبجکت لیبل lblMsg است .

Private Sub Form_Timer()
L = L + 1
Select Case L
    Case 1, 3, 5, 7, 9, 11, 13, 15, 17
        Me.lblMsg.Visible = True
        Me.lblMsg.Visible = False
    Case 2, 4, 6, 8, 10, 12, 14, 16, 18
    Case 19
       Me.TimerInterval = 0
       Me.lblMsg.forecolor = forecolor
       Me.lblMsg.Visible = True
End Select
End Sub
Private Sub TxtSearch_GotFocus()
     Me.lblMsg.Visible = False
End Sub

تغییر کالر و سایز فونت هر حرف در لیبل

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

حرکت رشته از راست به چت کاراکتر به کاراکتر در لیبل

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

فیلتر در اکسس

در تصویر زیر سه Toggle Button در OptionGroup با نام Frame5 قرار گرفته و ولیوی آنهای به ترتیب 0 تا 2 است با کلیک روی اولین باتن ،  تمام رکوردهایی که فیلد chk آنها تیک خورده یا نخورده در سابفرم آورده میشود Forms!Form1!Frame5=0 ، کلیک روی باتن دوم رکوردهایی که فیلد chk آنها غیر صفر است در سابفرم لیست میشود و باتن آخر هم لیست رکوردهایی  است که فیلد chk آنها صفر یا تیک ندارند 

Select-Query-Access-

filename=trysql_create_table

در تصویر زیر فرمی Simulate شده که سه کنترل CheckBox برای فیلتر کردن گرید A تا B ( فیلد Grade ) و دو کنترل CheckBox دیگر برای فیلتر کردن تیک خورده ها یا نخورده ها ( فیلد chk )، دارد چنانچه هیچکدام از ۵ چک باکس تیک نخورده باشند کل داده نمایان خواهد شد.( تعداد کل ورودی در تصویر ۹ رکورد بوده )

سمت راست تصویر چهار رکورد نمایش داده شده دقیقا تیک چک باکس گرید A و تیک چک باکس ( Unchecked مربوط به فیلد chk ) در فرم زده شده ...  طبق عبارت Sql کوئری شامل  رکوردهایی با گرید A که تیک  Chk آنها نخورده باشد.

بین هر فیلد از عملگر منطقی AND استفاده میشود و برای لیست کردن چند آیتم خاص از یک فیلد OR کاربرد دارد.

?'A' AND FALSE=FALSE

?'A' AND TRUE=NULL

'A' OR TRUE=TRUE

'A' OR FALSE=0

'A' OR TRUE=1

FALSE OR TRUE=TRUE

TRUE OR FALSE=TRUE

TRUE AND FALSE=FALSE

FALSE AND FALSE=FALSE

FALSE OR FALSE=FALSE

NULL AND FALSE=FALSE

NULL AND TRUE=NULL

NULL AND NULL=NULL

برای ارسال داده ها به اکسل نام کوئری را در دستور DOCMD.OUTPUTTO قرار می دهید.

Method vba/api/access.docmd.outputto

در تصویر زیر ، تصویر اول تمام رکوردهای جدول t نمایش داده شده شامل ۹ رکورد ایجاد شده با INSERT INTO ، تصویر سوم که فیلد DATE دارد شامل رکوردهایی است که کوچکت مساوی یک تاریخ خاص و نیز کوچکتر مساوی عدد 105 است ، تصویر چهارم یا آخر در تصویر زیر ، از رکوردهای داخل تصویر سوم آنهایی که تیک چک فیلد CHK آنها زده شده ( یا باصطلاح غیر صفر است ) را نمایش میدهد که شامل دو رکورد است .

در لینک زیر روش بیان شده ، البته هزینه بر است  (کلا در چند خط خیلی کوتاه و شامل 4 تصویر که بعد از اعمال کد SQL جدول فیلترشده) . برای ارسال داکیومنت آن درخواست دهید و بعد از واریز مبلغ ده هزار تومان به ایمیل شخصی ارسال خواهدشد.

Multi Filter  Select-Query-Access-

در تصویر زیر ، رکوردهایی که نام محصول به les ختم می شود لیست شده البته در SQL بجای علامت * در اکسس از % استفاده شده.اگر در اکسس عبارت جستجو بین دو * قرار بگیرد تمام رکوردهایی که نام محصول شامل آن عبارت است را می آورد چه آخر باشد چه هر جای دیگر رشته در فیلد نام محصول.

MULTIFILTER IN ACCESS : 

در تصویر زیر اینطور تصور شده که فرمی با دو چک باکس برای فیلتر کردن فیلد Available و یک کنترل تکست باکس برای فیلتر کردن محتویات فیلد GradeNo موجود است.

در تصویر در صورت تیک داشتن یا نداشتن جفت تکست باکس کل رکوردها که 11 رکورد با Insert Into ایجاد شده در سابفرم نمایش داده میشود. در صورت تیک چک باکس اول رکوردهای دارای  مقدار صفر یا False فیلد Available و تیک چک باکس دوم مقادیر غیر صفر یا True لیست میشوند . البته سابفرم باید Requery شود تا نتیجه فیلترشدن را ببینید.

برای اینکه در سابفرم تمام رکوردهای False و True فیلد Available نمایش داده شود می بایست  : 

Available=False  Or Available=True

حال اگر قرار باشد فیلد Available در کوئری بیلدر مقادیر ولیوی چک باکس ها در فرم را بگیرد میشود :( در صورتیکه جفت چک باکس ها تیک نخورده باشند = False )

Available=False  Or Available=False

و در اینصورت فقط  مقادیر صفر  یا False ها نمایش داده میشود ولی ما می خواهیم در صورت تیک نداشتن دو چک باکس و داشتن ولیوی صفر دو مقدار False  و True را مشاهده بنمائیم.پس باید یکی از طرفین مخاف False  شود.

FALSE OR  <>FALSE=TRUE   نمایش همه

TRUE  OR   <>FALSE = هاTRUE نمایش 

FALSE OR  <>TRUE= ها FALSE نمایش

TRUE  OR  <>TRUE=TRUE نمایش همه

در تصویر زیر دو تکست باکس تصور شده که در صورت تایپ عدد در این دو باکس اعدادی بین این دو که در جدول باشد نمایش داده میشود ، در صورتیکه یک باکس یا هر دو خالی بود از فیلتر در می آید . البته بدین شکل که اگر باکس دوم خالی باشد همه ی رکوردها و اگر باکس اول خالی باشد رکوردها تا مقدار باکس دوم مشاهده میشود در این دو تکست باکس چک میشود که اگر PartNo  در جدول نباشد ارور بدهد در رویداد LOST FOCUS می توان با DlookUp چک کرد اگر نبود  پراپرتی OldValue  مقدار Value  تکست باکسی شود که در حال Exit از آن هستید از رویداد Exit  هم میشود بهره برد.

حال در تصویر زیر  تکست باکس اول در فرم Null و تکست باکس دوم 1003 است ( جدول کلا 11 رکورد دارد )

(GradeNo>='' Or True) And (GradeNo<='1003' Or False) 

عبارت بالا برای زمانی نیست که در دو تکست باکس اعدادی تایپ شود که در جدول وجود ندارد یا حتی در آنها کاراکتر غیر عددی وارد شود اگر صحت موجود بودن مقادیر در جدول چک نشود این عبارت False را بر می گرداند و هیچ رکوردی نمایش داده نخواهد شد.

(GradeNo='123' Or False)  AND (GradeNo='896' Or False) 

False And False=False  ' No Record

بررسی عبارات زیر : 

(GradeNo Between '458' And  '678' Or False Or False)

458 , 678 Not Exist in Above Table

FALSE AND FALSE OR FALSE OR  FALSE=FALSE

پس چون نتیجه FALSE است رکوردی نمایش داده نخواهدشد.

(GradeNo Between Null And  '678' Or True Or False)

678 Not Exist in Above Table

NULL AND FALSE OR TRUE OR  FALSE=TRUE

پس چون نتیجه TRUE است تمام رکوردها نمایش داده خواهدشد.

(GradeNo Between Null And  Null Or True Or  True)

Two Boxes Are Null

NULL AND NULL OR TRUE OR  TRUE=TRUE

پس چون نتیجه TRUE است تمام رکوردها نمایش داده خواهدشد.

برای اینکه مقادیر وارد شده در دو تکست باکس را صحت سنجی نکنیم و در صورت تایپ مقداری خارج از جدول می بایست یک عبارت دیگر به شرط اضافع کرد مثل 

OR (TRUE AND FALSE) 

که در صورت پر بودن تکست باکس ها ،دو TRUE و FALSE داخل پرانتز TRUE شوند و در نتیجه کل رکوردها نمایش داده شوند و در اینجا جستجو کننده پی خواهد برد که یکی از مقادیر تایپ شده یا هر دو در جدول وجود ندارد البته جلوگیری از تایپ عددی یا تاریخی خارج از محتویات فیلد کار خوب و استانداردی است ولی خوب  کوئری نویسی آسان بنظر میرسد ولی می بینید به همین سادگی که گفته شد نیست مگر اینکه عملگرهای منطقی را کاملا فرا بگیرید.

>>>>>> nullguide-oper

 اگر دو تکست باکس  پر باشند ولی در جدول ناموجود می توانید عبارت بالا را اضافه کنید . ( ... BETWEEN....AND...OR...OR)

(NULL(FALSE) AND NULL(FALSE) OR TRUE OR TRUE )OR (TRUE AND TRUE)=TRUE   (NULL OR TRUE=TRUE)

تکست باکس اول NULL است و تکست باکس دوم مقداری که در فیلد GRADENO وجود ندارد یا حاوی کاراکتر غیر عددیست.

(NULL(FALSE) AND FALSE OR FALSE OR TRUE) OR (TRUE AND FALSE)=TRUE

NULL AND FALSE=FALSE

FALSE OR FALSE OR TRUE=TRUE

TRUE OR (TRUE AND FALSE)=TRUE OR FALSE=TRUE

 جستجو بین دو تاریخ : 

دو کنترل تکست باکس به نام های TXTDATEFROM و TXTDATETO . (   سعی کنید دو تا باکس را چک کنید اگر تاریخ اولی از باکس دومی بزرگتر بود خطائی صادر کرده یا باکس را NULL در نظر بگیرد.

BETWEEN TXTDATEFROM AND TXTDATETO OR FORMS!FORM1!TXTDATEFROM IS NULL OR FORMS!FORM1!TXTDATETO IS NULL

فرضا در جدول تاریخ های 1397/01/30 و 1398/02/01 نداریم تکست باکس ها را با این دو رشته پر می کنیم بعد از خروج از تکست باکس ها پراپرتی VALUE میشود مقادیری که گفته شد.چون دو تاریخ در جدول نیست پس برای هر کدام FALSE را بر می گرداند و نتیجه آخر FALSE است و هیچ رکوردی نمایش داده نخواهد شد.

(FALSE AND FALSE OR FALSE OR FALSE) =FALSE OR FALSE=FALSE  ' NO RESULT

اگر تکست باکس اول NULL باشد و تکست باکس دوم دارای رشته ای باشد که داخل جدول نباشد( =FALSE) و بالعکس تمام رکوردها لیست خواهند شد :

(NULL AND FALSE OR TRUE OR FALSE)=FALSE OR TRUE OR FALSE=TRUE 'SHOW ALL RECORDS

تصویر زیر ، خود گویای توضیحات ارائه شده بالا است . جدول شامل کلا ۱۱ رکورد است یکی از تکست باکس ها خالیست و برابر NULL و در دیگری عددی خارج از اعداد جدول ، زمان اجرای کوئری تمام ۱۱ رکورد نمایش داده شده.

دوستان فراگیر ، مطالبی که در این یادداشت ها قرار داده میشود کاملا توضیح داده شده از کپی کاری پرهیز و سعی کنید برای خواندن مطالب وقت گذاشته ، به داکیومنت آفیس که مرجع است مراجعه کنید . لطفا در نظر سنجی هم شرکت کنید ( از انتخاب منو گوشه راست بالا ). بنده برنامه نویس نیستم فقط یادداشت هایی که از سایتهای خارجی استخراج کرده را برای خودم و شما به اشتراک خواهم گذاشت انشاءا... .کلام آخر ، کد آماده به درد تازه واردها نخواهد خورد سعی کنید مطالب را از همین بلاگ یاد بگیرید.

نظرات باز است در زیر همین یادداشت هم می توانید اعلام نظر بفرمائید و نظرسنجی فراموش نشود !!!

( Select Query ( Access برای مشاهده محتویات نیازمند واریز مبلغ مورد نظر است

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

(Editing Record issues in Access / SQL (Write Conflict

زمان بردن جداول به Sql حتما چک کنید فیلدهایی که پرایمری کی نیست و نباید Null باشد  پر شده باشد وگرنه خطا میدهد  

Int

Bigint

Is there a bit field in your table? i.e. ‘1 or 0 ‘ or ‘yes or no’?

I’ve seen Access kick back those errors on linked tables with a bit field and no default value set.

You might want to add a timestamp field to the table as that seems to often resolve this problem.

Another possibility is that you are editing a record in a form and the form is dirty (i.e., edits not saved) and you run code that uses DAO or ADO to run SQL to update the same record. Jet sees that as 2 users editing the same record. Try to force a save before running the SQL update:

If Me.Dirty Then

Me.Dirty = False

End If

[run SQL update here]

When a record is saved, Microsoft Access sets the Dirty property to False. When a user makes changes to a record, the property is set to True.

زمان تغییر True و ذخیره False 

Form.Dirty event (Access)  : 

زمان تغییر محتویات کنترل مشخصی اتفاق می افتد

The Dirty event occurs when the contents of the specified control changes.

نوشتاری : 

Syntax : 

expression.Dirty (Cancel)

این تنظیم تعیین می کند آیا رخ می دهد یا خیر ، تنظیم آرگومان Cancel به True

Cancel : 

The setting determines if the Dirty event occurs. Setting the Cancel argument to True

MultiSelection Microsoft Access

ComboBox.ItemData property (Access) :

expression.ItemData (Index)

پراپرتی ItemData داده در ستون باند شده برای ردیف مشخص شده در یک کمبو باکس را بر می گرداند. ایندکس از صفر شروع میشود

با استفاده از مجموعه ItemSelected می توانید تعیین کنید که کدام ردیف یا ردیف ها در لیست باکس آن انتخاب شده 

باید پراپرتی MultiSelect لیست یاکس به Simple یا Extended تنظیم شود تا کاربر قادر به انتخاب بیشتر از یک ردیف باشد.

از پراپرتی Column هم می توانید استفاده کنید که داده کدام ستون و ردیف برگردانده شود.

ListBox.ItemsSelected property (Access) :

مجموعه ItemSelected دو پراپرتی Count و Item دارد بدون داشتن هیچ متدی البته

Dim frm As Form, ctl As Control

Dim varItm As Variant

Set frm = Forms!Contacts

Set ctl = frm!Names

For Each varItm In ctl.ItemsSelected

Debug.Print ctl.ItemData(varItm)

Next varItm

مثال بالا مقدار باند کالمن هر ردیف انتخاب شده را چاپ میکند در پنجره immidiate window

مثال زیر باز شدن گزارش با شرط خاصی مشخص شده، یک لیست MultiSelection است و چنانچه کاربر  یک یا چند داده را انتخاب کند و باتن cmdOpenReport را بفشارد گزارش حاوی داده ها ی گرفته شده باز میشود.

Private Sub cmdOpenReport_Click()

    Dim varItem As Variant

    Dim strEmployeeIDList As String

    Dim strCriteria As String

    Dim ctrl As Control    

    Set ctrl = Me.lstEmployees    

با پراپرتی کانت چک میکند که حداقل یک گزینه از لیست باکس انتخاب شده باشد.

    If ctrl.ItemsSelected.Count > 0 Then

در کد For Each....Next  داده آیتم یا آیتم های انتخاب شده را با پراپرتی ItemData ی کنترل میگیرد ، بین آنها کاما گذاشته و به متغیر strEmployerIDList میدهد

        For Each varItem In ctrl.ItemsSelected

            strEmployeeIDList = strEmployeeIDList & "," & ctrl.ItemData(varItem)

        Next varItem

      چون یک کاما قبل از اولین آیدی گرفته شده ( متغیر)  قرار می گیرد با تابع Mid گفته که عبارت بعد از کاما در متغیر قرار گیرد در نتیجه آن کاما حذف میشود.

        ' remove leading comma

        strEmployeeIDList = Mid(strEmployeeIDList, 2)     

حال نوبت به نوشتن شرط یا Criteria است که در  آرگومان WhereCondition  قرار داده شده  in هم کلمه ای است رزرو شده که در عبارات sql استفاده میشود و بیان نموده که strEmployeeIDList هایی که در فیلد EmployeeID ( دیتا تایپ نامبر است ) موجود است فهرست شوند .... چون ID نامبراست احتیاجی نیست که بین هر داده گرفته شده کوتیشن قرار گیرد ولی اگر دیتا تایپ فیلد تکست بود می بایست بین هر داده ای که از لیست باکس گرفته میشود غیر از همرا بودن با کاما ، تک کوتیشن نیز در ابتدا و انتهای آن قرار گیرد.

        strCriteria = "EmployeeID In(" & strEmployeeIDList & ")"

در کد زیر دستور باز شدن گزارش rptEmployees با چشم انداز Preview و شرط strCriteria داده شدس.

        DoCmd.OpenReport "rptEmployees", _

            View:=acViewPreview, _

            WhereCondition:=strCriteria

    Else

اگر هیچ آیتمی در لیست باکس انتخاب نشده باشد پیغامی را با Msgbox رایز میکند با پرامپت هیچ کارمندی انتخاب نشده.

        MsgBox "No employees selected", vbInformation, "Warning"

    End If

   

End Sub

expression.Column (Index, Row)

پراپرتی کالمن در آبجکت کمبو و لیست باکس که index اشاره به ستون مورد نظر دارد و Row هم اشاره به ردیف و از صفر شروع میشوند. فرضا شما میخواهید داده ستون دو و ردیف سوم را بگیرید.

.Column(1,2)

زمانیکه پراپرتی MultiSelect کنترل لیست باکس به None تنظیم شود فقط یک آیتم می تواند انتخاب شود و پراپرتی Selected می تواند به True تنظیم شود.وقتی پراپرتی MultiSelect کنترل لیست باکسی به Simple یا Extended تنظیم شود هر کدام یا تمام آیتم های انتخاب شده می تواند پراپرتی Selected برابر True خودش را داشته باشد. پس مشخص شد با Selected می توانید مشخص کنید کدام آیتم یا آیتم ها Select شده اگر True باشد انتخاب میشود و اگر به False تنظیم شود از حالت انتخاب در می آید.

لیست باکس چند انتخابی یا Multi-Selection باند شده به فیلدی همیشه دارای پراپرتی Value مساوی با Null است . می توان از پراپرتی Selected یا مجموعه ItemSelected برای بازیابی اطلاعات آیتم هایی که انتخاب شده اند ، استفاده نمود.

 عبارت زیر پنجمین آیتم در لیست را انتخاب ( Select ) می نماید

نام کنترل لیست باکس در اینجا ListBox1 است

 Me!Listbox1.Selected(4)=True

ComboBox.LimitToList property (Access) :

از پراپرتی LimitToList برای محدود کردن مقادیر کمبو باکس به آیتم های لیست شده استفاده میشود یعنی اگر به True تنظیم شود اگر مقداری در تکست باکس کمبو تایپ شود و در لیست نباشد زمان Enter و از دست دادن فوکس خطایی را نمایش میدهد که آیتم در لیست نیست.

Forms("Order Entry").Controls("States").LimitToList = True 

اگر بخواهید پیغام خودتان را نشان دهد در رویداد NotInList می توانید Response را مساوی صفر و پیام مورد نظرتان را در Msgbox قرار دهید

ComboBox.ListCount property (Access) :

تعیین تعداد ردیف های لیست باکس قسمتی از کمبو باکس ( کمبو باکس همانطور که در یادداشت های دیگر گفته شده یک قسمت تکست باکس و یک قسمت DropDown دارد.

اگر  پراپرتی ColumnHeads به True تنظیم شود این ردیف هم اضافه میشود یعنی ایندکس آن صفر است

ComboBox.ListRows property (Access) :

برای تنظیم حداکثر تعداد ردیف هایی که در لیست باکس قسمت کمبو باکس نمایش داده شود کاربرد دارد.

ComboBox.Locked property (Access) :

پراپرتی Locked مشخص میکند که می توان داده را در کنترلی در فرم ویرایش کرد.دیفالت True است

و این تنظیم اجازه ویرایش ، حذف و اضافه کردن داده را می دهد.

ComboBox.ListIndex property (Access) : 

از این پراپرتی برای تعیین اینکه کدام آیتم در کمبو انتخاب شده کاربرد دارد و بین صفر تا تعداد آیتم هادر لیست باکس یا کمبو باکس منهای یک است

مقدار پراپرتی ListIndex با تنظیم پراپرتی BoundColumn به صفر در دسترس است. اگر پراپرتی BoundColumn مقدار صفر بگیرد فیلدی که به کمبو یا لیست باکس باند شده حاوی همان مقداری خواهد شد که پراپزتی ListIndex تنظیم شده.

Here is the code to take data from a list box to a table...

Code:

کد زیر برای بردن داده از یک لیست باکس به یک جدول  و از کوئری Append استفاده شده البته Sql آن .

Private Sub Command14_Click()

Dim varName As Variant

Dim varItem As Variant

Dim strSQL As String

Dim undSQL As String

Dim CmbValue As String 

CmbValue = Me.Combo0.Value 

With Me.List9 

For Each varItem In .ItemsSelected

در عبارت Sql زیر در Insert into نام جدول و بعد داخل پرانتز نام فیلدهایی که باید داده به آن اضافه شوند و بعد Values و داخل پرانتز داده ها برای داده های فیلد از نوع دیتا تایپ تکست از تک کوتیشن در ابتدا و انتهای متغیر استفاده می شود . به پرانتزها و فواصل توجه کنید وگرنه خطای Syntax یا نوشتاری خواهید گرفت.

strSQL = "INSERT INTO tlbTempRecordset (UnderwriterName, ST_CODE) VALUES ('" & .Column(0) & "','" & .ItemData(varItem) & "');"

DoCmd.RunSQL (strSQL)

عبارت زیر حتما باید اعمال گردد وگرنه مقادیر تکرار و تکرار میشوند چون در لوپ هستیم   و اتومات Reset  نمی شود عزیزان

strSQL = ""

Next varItem 

End With 

Me.List9.Value = Null 

End Sub

در فرم امکان ساخت کنترل کمبو باکسی که MultiSelection باشد ،  نیست و فقط در جدول این پراپرتی  برای فیلد از نوع کمبو باکس وجود دارد.

is