ساخت ماکرو باتن برای انجام فیلترها در اکسل ( AutoFilter )

VBA Macro Buttons for Filters in Excel

July 19, 2018

Jon Acampora

13 comments

لینک فرم ها به یکدیگر در اکسس

نوشتن کد باز کردن فرم دیگر در رویداد کلیک Id و تنظیم پراپرتی Is Hyperlink در تب Format به Yes 

in the Property Sheet, click the Format tab, and set

. the Display As Hyperlink property to Always

برگشت یک مقدار یا ارجاع به یک مقدار از داخل جدول یا محدوده در اکسل ( تابع INDEX )

[INDEX(reference, [row_num],[column_num],[area_num

((INDEX($B$3:$E$10,MATCH($G$5,$A$3:$A$10,0),MATCH($H4,$B2:$E$2,0=

میانگین Area_Num که در B1 دو تعیین شده 

(42+4,800+10+3,126
+3,629+94+1,578+1,190
+54)÷11=1320.2727

جستجوی افقی + موقعیت مقدار پیداشده در اکسل ( Hlookup+Match )

در تصویر پایین آرگومان Match Type که آپشنال یا انتخابیست  گویای این است که اگر مقدار نداشته باشد دیفالت 1 در نظر گرفته و برگشتی تابع (  اگر مورد جستجو  عدد باشد  ) بزرگترین عددی است که مساوی یا کوچکتر از مقدار جستجو باشد.

اگر صفر در نظر گرفته شود که در صورت پیدا کردن همان مقدار در جدول مورد جستجو تابع درست است وگرنه N/A  میدهد

اگر 1- بگیرید برگشتی تابع کوچکترین مقداریست که از عدد  مورد جستجو بزرگترو یا مساوی باشد 

در تصویر پائین  تابع Match موقعیت سل A6 را در محدوده ی A1 تا A3 را بر می گرداند که در اینجا میشود عدد ۳ ( Match Type را صفر در نظر گرفته که طبق تصویر اول باید مقدار جستجو دقیقا در جدول یا محدوده باشد ) و آرگومان  آخر تابع Hlookup هم که فالز است نشان میدهد که مقدار جستجو دقیقا باید در آن جدول یا محدوده باشد ... در نتیجه تابع Hlookup مقدار جستجو (  Laura ) را در رنج B1 تا H3 مورد جستجو قرار میدهد و مقدار ردیف سوم از آن را برمی گرداند ( عدد 237 )

درتصویر پایین تابع Match موقعیت Salary در رنج A1 تا A5 را پیدا کرده ( فقط در محدوده نه موقعیت در کل Row )  و بر میگرداند ( اگر پیدا نکند N/A  میدهد )  که میشود عدد ۴ ، در تابع Hlookup  باید حقوق یا Salary را طبق مقدار جستجو ( آیدی استخدامی یا  Emp ID )   برگرداند. 

جستجوی افقی در اکسل ( HLookup )

Range_lookup    Optional. A logical value that specifies whether you want HLOOKUP to find an exact match or an approximate match. If TRUE or omitted, an approximate match is returned. In other words, if an exact match is not found, the next largest value that is less than lookup_value is returned. If FALSE, HLOOKUP will find an exact match. If one is not found, the error

. value #N/A is returned

این پارامتر اگر خالی باشد True در نظر گرفته میشود و تقریبا مقداری نزدیک به آن را برخواهد گرداند و اگر False باشد دقیقا همان مقدار ( در مقدار False  اگر پیدا نکرد طبق گفته ی بالا  N/A را بر می گرداند ) 

در شکل پائین آرگومان آخر تابع که آپشنال و انتخابی است ( یعنی اگر پارامتر نداشته باشد هم خطا نخواهد داد ) ذکر نشده در نتیجه  دیفالت True در نظر گرفته شده و عدد برگشتی  ( طبق آرگومان Row_index_num که 2 است ) متناسب با تاریخ جستجو شده  ( Lookup Value )  در  آرگومان Array - Table Range )   تقریبا نزدیک به آن مقداری که باید جستجو شود است 

فاکتور خودکار در اکسل ( VlookUp, Data-Validation )

Automated Invoice

 

فرم ورود داده در اکسل ( تبدیل رنج به جدول )

فیلتر داده بر اساس مقدار سل ( لیست کشویی ) - بررسی اعتبارداده ( Data-Validation )

Filter Data based on a Cell Value

استخراج از سایت خارجی 

تنظیم عنوان یا تکست کنترل در دیالوگ باکس #32770

GetDlgCtrlID	Retrieves the identifier of the specified control.
GetDlgItem	Retrieves a handle to a control in the specified dialog box.

MENUBARINFO

Type rect

      Left As Long

      Top As Long

      Right As Long

      Bottom As Long

End Type

Type MENUBARINFO

     cbSize As Long

     rcBar As rect

     hMenu As Long

     hwndMenu As Long

     fBarFocused As Boolean

     fFocused As Boolean

End Type

Public Const OBJID_MENU As Long = &HFFFFFFFD

Pubic Const OBJID_SYSMENU As Long = &HFFFFFFFF

Dim mbi as MENUBARINFO

mbi.cbSize=LenB(mbi)

GetMenuBarInfo Me.hWnd,OBJID_MENU, lMenuNumber, mbi

Where "lMenuNumber" is 1 for the first (e.g. "File"), 2 for the second (e.g. "Edit"), etc.

rcBar.Left

تغییر کپشن و ترتیب چیدمان ( راست ) منوی سیستمی

MIIM_STRING = 64

MIIM_FTYPE = 256

MFT_RIGHTORDER = 0x2000

MF_BYPOSITION = 0x00000400

For j = 0 To MenuCount - 1

With mii

(BuffLen = GetMenuStringA(hMenu, j, Buff, Len(Buff) + 1, &H400

(txt = Left$(Buff, BuffLen

       (cbSize = Len(mii

    fMask = 64 Or 256

     fTyp = &H2000

      dwtypedata = arr(j) 'txt

      cch = Len(.dwtypedata) + 1

      .fState = &H3 'mfs_disabled

End With

SetMenuItemInfoA hSysMenu, GetMenuItemID(hMenu, j), 0, mii

Next

"InsertMenuA hSysMenu, 6, MF_BYPOSITION Or MF_STRING Or &H2000, 10200, ByVal "Salam

For j = 0 To (hc + 1) - 1

گزینه های پنجره ی باز شده در اکسس

Overlapped

Tabbed

غیرفعال کردن ( دورزدن ) صفحه ی شروع آفیس

ByPass Start Screen

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

موارد ستاره دار مهم هستند که اگر Fail دهد جواب صفر است  و اگر cchMax صفر در نظر گرفته شود تابع طول استرینگ  را بر خواهد گرداند درصورتیکه که Fail ندهد یعنی مقدار برگشتی صفر نشود

***cchMax : 

If nMaxCount is 0, the function returns the length of the menu string

***Return Value

If the function succeeds, the return value specifies the number of characters copied to the buffer, not including the terminating null character.

If the function fails, the return value is zero.

If the specified item is not of type MIIM_STRING or MFT_STRING, then the return value is zero

گرفتن-نام-منوهای-SystemMenu

Dim mii As MENUITEMINFOA

(mii.cbSize=Len(mii
mii.fmask=&H40  ' MIIM_STRING
mii.ftype=&H0      ' MFT_STRING
""=mii.dwTypedata
mii.cchMax=0

GetMenuItemInfo hMenu,0,True,mii

(mii.cbSize=Len(mii'
mii.fmask=&H40'
mii.fType=&H0'
(mii.dwTypedata=String$(cchMax,vbNullChar
mm.cchMax=mii.cchMax+1

GetMenuItemInfo hMenu,0,True,mii

و  در آخر گرفتن کپشن با Mid

GetMenuStringA(hMenu,uIDItem,lpString, cchMax,flags)

If the specified item is not of type MIIM_STRING or

. MFT_STRING, then the return value is zero

lpString

Type: LPTSTR

The buffer that receives the null-terminated string. If the string is as long or longer than lpString, the string is truncated and the terminating null character is added. If lpStringis NULL, the function returns the length of the

 .menu string

 Note  The GetMenuString function has been****

superseded. Use the GetMenuItemInfo function to retrieve the menu item text

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

 (&Retval=SendMessage(SendTxtHwnd,WM_SETTEXT, 0

 (ByVal MyString

"FindWindowEx ----->>> "Button

&RetVal = SendMessage(SendButtonHwnd, BM_CLICK,0

 (&0

بعضی ازکلاس های فرم اکسس

البته  هندل  همه کنترل ها را نمیشود بدست آورد فقط چیزی که فعال باشد یا Active ولی در برنامه های ساخته شده ویندوزی هر کدام از کنترل ها دارای آیدی خودش است مثل دیالوگ باکس دیباگ اکسس  ( که کلاس سیستم را داراست ) که تمام باتن ها آیدی خودشون رو دارا هستند.

class name for Edit controls in Access=Okttbx

class name for an Access form's client window=OFormSub

(ComboParent=FindWindow("ODCombo",vbNullString

(DropDown=GetWindow(ComboParent, GW_CHILD

if DropDown="OGrid" Then 

if GetWindowLongPtrA(ComboParent,GWL_STYLE) And WS_VISIBLE Then

ComboOpen=True

End If

End If 

خالی کردن حافظه مشخص شده

GlobalFree function globalfree globalalloc

In this article

1. Syntax
2. Parameters
3. Return Value
4. Remarks
5. Requirements
6. See Also

Frees the specified global memory object and invalidates its handle

(pSD=GlobalAlloc(GHND,Len(MyString)+1
(GlobalFree(pSD

Dim pSD As LongPtr
$MyString
"MyString="MyClose
(pSD=GlobalAlloc(GHND,Len(MyString)+1
Dim mii As MENUITEMINFOA
With mii
       (cbSize = Len(mii
      .fMask = &H40 Or &H100 '       miim_string Or miim_ftype
      .fTyp=MFT_STRING
       "dwtypedata =pSD    ' "MyClose
       cch = Len(MyString) + 1
      End With
  
SetMenuItemInfoA hSysMenu, SC_CLOSE, 0,mii
GlobalFree pSD

Private Sub Form_Load()
    Dim s As String
    '
    s = ChrW(&HCD38) & ChrW(&HC988) & ChrW(&HBD38) & ChrW(&H7EBA)
    ModifyMenuW GetMenu(Me.hwnd), 0, MF_BYPOSITION, 0, ByVal StrPtr(s)
End Sub

ثابت های Bitmap آیتم منو در MenuIteminfoA

 D:  Means Disabled

HBMMENU_SYSTEM = 1
	HBMMENU_MBAR_RESTORE = 2
	HBMMENU_MBAR_MINIMIZE = 3
	HBMMENU_MBAR_CLOSE = 5
	HBMMENU_MBAR_CLOSE_D = 6
	HBMMENU_MBAR_MINIMIZE_D = 7
	HBMMENU_POPUP_CLOSE = 8
	HBMMENU_POPUP_RESTORE = 9
	HBMMENU_POPUP_MAXIMIZE = 10
	HBMMENU_POPUP_MINIMIZE = 11

MF_GRAYED=&H1  : MF_DISABLED=&H2 : MF_BYPOSITION=&H40

Dim Hicon As IntPtr = img.GetHbitmap

        'remove first item
        RemoveMenu(iMenu, 0, MF_BYPOSITION)
        DrawMenuBar(iMenu)
        'add new item
        InsertMenu(iMenu, 0, MF_BYPOSITION, 0, "Restore")
        DrawMenuBar(iMenu)
        SetMenuItemBitmaps(iMenu, 0, MF_GRAYED Or MF_BITMAP, Hicon, Hicon)
        'disable
        EnableMenuItem(iMenu, 0, MF_BYPOSITION + MF_DISABLED + MF_GRAYED)
        DrawMenuBar(iMenu)9

شرح منوها و بیان نحوه ی کاربرد آنها و پیام های ارسالی به Window Parent

Menus    menus

استخراج آیکون از فایل DLL یا EXE

ExtractIconExA(lpszFile,nIconIndex, HICON *phiconLarge, HICON *phiconSmall, UINT

( nIcons

nIconIndex : 

If this value is –1 and phiconLarge and phiconSmall are both NULL, the function returns the total number of icons in the specified file

Declare PtrSafe Function DrawIcon Lib "user32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal hIcon As LongPtr) As Long

Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long

Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr 

نمایش مسیر کامل فایل در تایتل بار

نمایش Bitmap کنار منو ( پیوند BitMap مشخص شده به آیتم منو )

Type: HBITMAP

A handle to the bitmap to be displayed, or it can be one of the values in the following table. It is used when the MIIM_BITMAP flag is set in the fMask member

uflags: MF_BYCOMMAND

hBitmap:LoadBitmap,LoadIcon,LoadImage

Dim mim As MENUITEMINFOA

(mim.cbSize = Len(mim

   mim.fMask = MIIM_BITMAP

mim.hbmpitem=1

SetMenuItemInfoA hSysMenu, 6, 1, mim

Use the GetSystemMetrics function with the CXMENUCHECK and CYMENUCHECK values to retrieve the bitmap dimensions.

تصویر بالا با استفاده از تابع زیر ( foo هندلی برای Bitmap ) و   loadimagea ( در آرگومان Type حتما IMAGE_BITMAP  استفاده شود ) بدست آمده  ضمنا  Bitmap ها در Shell32  در اینترنت وجود دارد و می توانید در سیستم خود لود نمایید و مانند زیر استفاده کنید .

windows_7_shell32_dll.shtml

SetMenuItemBitmaps hMenu, 1,MF_BYPOSITION, foo, foo

گرفتن استرینگ آیتم های SystemMenu

در تصویر بالا تعداد آیتم ها عدد 6 است 

szItem As String*100

((szItem=String$(100,Chr(0

(hSysMenu=GetSystemMenu(hwnd

(hSysMenuItmCount=GetMenuItemCount(hSysMenu,0

For i=0 To hSysMenuItmCount

(ItemId=GetMenuItemId(hSysMenu,i

(Length=GetMenuString(hSysMenu,i,szItem,Len(szItem)+1,MF_BYPOSITION

(txt=Left$(szItem,Length

Debug.Print txt,ItemId,i

Next

درباره ی تابع GetMenuString 

If the function succeeds, the return value specifies the number of characters copied to the buffer, not including the terminating null character.

If the function fails, the return value is zero.

If the specified item is not of type MIIM_STRING or MFT_STRING, then the return value is zero.

Remarks

The nMaxCount parameter must be one larger than the number of characters in the text string to accommodate the terminating null character.

If nMaxCount is 0, the function returns the length of the menu string.

درباره تابع  GetMenuItemCount 

Return Value

Type: int

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

If the function succeeds, the return value specifies the number of items in the menu.

If the function fails, the return value is -1

درباره  تابع  GetMenuItemId

Return Value

Type: UINT

مقدار برگشتی شناسه ی آیتم منوی مشخص شده خواهد بود اگر شناسه ی آیتم منو نال یا شامل ساب منو باشد عدد برگشتی 1- است که اثبات و تست شده.  

The return value is the identifier of the specified menu item. If the menu item identifier is NULL or if the specified item opens a submenu, the return value is -1.

درباره تابع ModifyMenu

(idItem=GetMenuItemID(hmenu, uItemPos

ModifyMenu hmenu,idItem,MF_BYCOMMAND+MF_STRING,idItem, szItem

Return Value

Type: BOOL

اگر تابع ( عملکرد ) موفقیت آمیز باشد مقدار برگشتی عددی غیرصفر است خواه مثبت یا منفی  و در صورت عدم موفقیت صفر را برخواهد گرداند.

If the function succeeds, the return value is nonzero

If the function fails, the return value is zero

MENUINFO گرفتن اطلاعات منوبار

Public Const MIM_BACKGROUND As Long = &H2
Public Const MIM_APPLYTOSUBMENUS As Long
 &H80000000=
Pubkic Type MENUINFO
cbSize As Long
hbrBack As Long
fMask As Long
dwStyle As Long
cyMax As Long
End Type



.fMask=MIM_BACKGROUND

.hbrBack=CreateSolidBrush(vbYellow)

SetMenuInfo GetMenu(Me.hwnd),mi

.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS

.hbrBack=CreateSolidBrush(vbCyan)

SetMenuInfo GetSubMenu(GetMenu(Me.hwnd),0),mi

.hbrBack=CreateSolidBrush(vbGreen)

SetMenuInfo GetSubMenu(GetMenu(Me.hwnd),1),mi

.hbrBack=CreateSolidBrush(vbRed)
SetMenuInfo GetSubMenu(GetMenu(Me.hwnd),2),mi









tagMENUITEMINFOA {
  UINT      cbSize;
  UINT      fMask;
  UINT      fType;
  UINT      fState;
  UINT      wID;
  HMENU     hSubMenu;
  HBITMAP   hbmpChecked;
  HBITMAP   hbmpUnchecked;
  ULONG_PTR dwItemData;
  LPSTR     dwTypeData;
  UINT      cch;
  HBITMAP   hbmpItem;


fMask

MIIM_FTYPE
0x00000100
Retrieves or sets thefType member.
MIIM_ID
0x00000002
Retrieves or sets thewID member.
MIIM_STATE
0x00000001
Retrieves or sets thefState member.
MIIM_STRING
0x00000040
Retrieves or sets thedwTypeDatamember.



fType


MFT_RIGHTJUSTIFY
0x00004000L
Right-justifies the menu item and any subsequent items. This value is valid only if the menu item is in a menu bar.
MFT_RIGHTORDER
0x00002000L
Specifies that menus cascade right-to-left (the default is left-to-right). This is used to support right-to-left languages, such as Arabic and Hebrew.
MFT_SEPARATOR
0x00000800L
Specifies that the menu item is a separator. A menu item separator appears as a horizontal dividing line. ThedwTypeData andcch members are ignored. This value is valid only in a drop-down menu, submenu, or shortcut menu.
MFT_STRING
0x00000000L
Displays the menu item using a text string. ThedwTypeDatamember is the pointer to a null-terminated string, and the cchmember is the length of the string.
MFT_STRING is replaced by MIIM_STRING.


Public Sub SetMenuBackground() 
MenuHandle = GetSystemMenu(form.Handle,0) 
Dim brush
Brush=CreateSolidBrush(RGB(200,100,200)) 
Dim mi As MenuInfo 
mi.cbSize=Len(MenuInfo)
mi.fMask=&H2 
mi.hbrBack=brush 
SetMenuInfo(MenuHandle,mi) 
End Sub




Private Sub Form_Load()
Dim ret As Long
Dim hMenu As Long
Dim hBrush As Long
Dim lbBrushInfo As LOGBRUSH
Dim miMenuInfo As tagMENUINFO
lbBrushInfo.lbStyle=BS_SOLID
lbBrushInfo.lbColor=RGB(155, 100, 200)
lbBrushInfo.lbHatch = 0
hBrush=CreateBrushIndirect(lbBrushInfo)
hMenu = GetMenu(Me.hwnd)
miMenuInfo.cbSize = Len(miMenuInfo)
ret=GetMenuInfo(hMenu, miMenuInfo) ' 0 means failure
miMenuInfo.fMask =MIM_BACKGROUND 
'MIM_APPLYTOSUBMENUS  use this to apply to submenus as well
miMenuInfo.hbrBack=hBrush
ret=SetMenuInfo(hMenu,miMenuInfo) '0 means failure
End Sub

پیام WM_INITMENU برای چک مارک منو آیم

The following example has three menu items and moves the check mark of the menu item each time the menu is opened.

Public Function WndProc (HWND hWnd, UINT iMessage

( WPARAM wParam, LPARAM lParam,

 HDC hdc

PAINTSTRUCT ps

 static int count = 0

 Mes="Checks menu items in order every time the menu is

" opened

 Select Case iMessage

 case WM_INITMENU

  CheckMenuItem (HMENU) wParam

(IDM_MENU1,MF_BYCOMMAND | MF_UNCHECKED , 

,CheckMenuItem (HMENU) wParam, IDM_MENU2,m

( MF_BYCOMMAND | MF_UNCHECKED

CheckMenuItem ((HMENU) wParam, IDM_MENU3, MF_BYCOMMAND | MF_UNCHECKED)

count = (count +1)% 3

CheckMenuItem (HMENU) wParam, IDM_MENU1 + count, MF_BYCOMMAND | MF_CHECKED)

Wndproc=False

case WM_PAINT

(hdc = BeginPaint (hWnd, ps

(TextOut hdc, 10, 10, Mes,len(Mes

  (EndPaint (hWnd,ps

 WndProc=False

case WM_DESTROY

 PostQuitMessage (0

 WndProc=False

Case Else

(Wndproc=DefWindowProc (hWnd, iMessage, wParm,lParam

End Select

Exit Function