مرتب سازی اعداد در اکسس با استفاده از VBA

ساده ترین روش مرتب نمودن اعداد بصورت صعودی 

البته وقتی سورس اعداد در جدول یا کوئری باشد  میشود در Query Builder ،  عملیات Sort را انجام داد و در لیست باکس بدون هیچ دردسری مرتب سازی را مشاهده نمود ولی  هدف یادگیری زبان VBA است وگرنه نیازی به اینکاری که انجام دادیم نیست 

برای سورت یا مرتب سازی اعداد بصورت صعودی یا ASC از روش جایگزینی دو عدد مقایسه شده استفاده شده که اگر بزرگتر بود با عدد کوچکتر در آرایه جابجا شوند فرضا  اعدا  8,3,12 مشهود است نتیجه بصورت مرتب سازی صعودی می بایست 3,8,12 باشد

(Dim A(2

A(0)=8

A(1)=3

A(2)=12

عدد اول را از آرایه میگیریم 

N=A(0)=8

یک لوپ میزنیم 

 For i=0 To 2....Next

در لوپ اگر N از( A(i بزرگتر بود جای آنها عوض میشود در مثال بالا N=8 از A(i)=3 بزرگتر است در نتیجه A(0)=3 و A(1)=12 میشود و در آخر  A(i)= N در غیراینصورت ( N=A(i

8,3,12

3,8,12

یا فرضا مرتب سازی صعودی اعداد 2,6,4,0,1  و مراحل انجام شده توسط کد 

0:2,6,4,0,1

1:2,4,0,1,6

2:2,0,1,4,6

3:0,1,2,4,6

4:0,1,2,4,6

یک لوپ دیگر بین این لوپ لازم است تا چرخه ادامه پیدا کند 

و با لوپ دیگر میتوان آخرین مرحله که همان سورت شده ی اعداد در آرایه است را در خروجی  مشاهده نمود 

For j=0 To 2 

(Debug.Print A(j

Next

روش های پیچیده دیگری هم در اینترنت وجود دارد  ولی ساده ترین روش که قابل فهم باشد مانند توضیحات ذکر شده در بالا است.

Split text In 3 Boxes

مثالی در جدا کردن تکست ها با نشانه ی فاصله یا Delimiter از یک فروم خارجی جهت استفاده 

Extract Number From Text

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

Function GetNumber(ByVal pStr As String) As Long
Dim intLen  As Integer
Dim n       As Integer
    pStr = Trim(pStr) 'removes leading & trending spaces
    intLen = Len(pStr) 'stores original length
    n = 1 'consider this a counter & position marker
    If pStr = "" Or IsNull(pStr) Or intLen = 0 Then Exit Function 'validate we didn't get passed an empty/null string
    Do
        If IsNumeric(Mid(pStr, n, 1)) Then 'check if that single character is a number
            GetNumber = GetNumber & Mid(pStr, n, 1) 'if it is add to existing ones if any
    Loop Until intLen = (n - 1) 'go until we processed all characters. The reason we have to do n-1 is that Len starts at 0 & we told n to start at 1
            n = n + 1 'add to counter so we know to go to next character on the next pass/loop
        Else
            n = n + 1 'it wasn't a number, add to counter so we know to skip it
End Function 'if no numbers function will return default value of data type, in our case long would be 0
        End If

All cred

Dynamic search filter

استفاده از FilterOn و رویداد KeyUp برای فیلتر در FirstName یا LastName هر کدام بود فیلترشود

در کد زیر که از سایت خارجی استخراج شده و در رویداد KeyUp استفاده شده نتیجه آن در شکل بعد از کد نمایان گردیده  بطوریکه با فشردن هر کلید چنانچه در یکی از فیلدهای First یا Last بود دیتا گرید فیلتر میشود ، در شکل Tom تایپ شده و نهایتا هر رشته ای از این دو فیلد که در آن Tom دارد فیلتر شده بطور خودکار کار میکند یعنی وقتی T تایپ شود تمام رشته هایی در این دو فیلد که شامل T میشوند خواه در اول باشد یا آخر یا وسط فیلترمیشود بعد از تایپ o تمام رشته هایی که To دارند فیلتر میشوند و الی آخر 

If Len(txtNameFilter.Text) > 0 Then
   filterText = txtNameFilter.Text
   Me.Form.Filter = "[Contacts]![first_name] LIKE  
 filterText]  & "*' OR [Contacts]![last_name] & "*'
  "'*" & LIKE '*" & filterText 
   Me.FilterOn = True
  Retain filter text in search box after refresh'
   txtNameFilter.Text = filterText
   (txtNameFilter.SelStart = Len(txtNameFilter.Text 
Else
   Remove filter'
"" =  Me.Filter 
   Me.FilterOn = False
   txtNameFilter.SetFocus
End If

	
		

جدا کردن ارقام در VBA

فرض کنید رشته  x1y135 موجود است و میخواهید ارقام را از آن جدا کنید ( خروجی 1135 شود ) 

اولین کار زدن لوپ ( For.....Next ) در طول آن رشته است ( تابع Len ) و  استفاده از تابع MID برای نمایش کاراکترو اینکه در همان کاراکتر مشخص کنید اگر رقم ( Digit ) بود در متغیری مثل s ذخیره شود 

%Dim i

$Dim s

(For i=1 To Len(txt

(Select Case MID(txt,i,1

Case 0 To 9 

(1, s=s & MID(txt,i

End Select

Next

Msgbox s 

مورد بالا از سایت آفیس اقتباس شده البته روش های دیگری غیر از Select Case هم وجود دارد .

از IsNumeric هم میشود استفاده کرد و اگر نتیجه ی MID نامبر بود در یک متغیر ذخیره نماید 

RC4

Function fRunRC4(sMessage, strKey) As String Dim kLen, x, y, i, j, temp Dim s(256), k(256)

'Init keystream
kLen = Len(strKey)
For i = 0 To 255
    s(i) = i
    k(i) = Asc(Mid(strKey, (i Mod kLen) + 1, 1))
Next
j = 0
For i = 0 To 255
    j = (j + k(i) + s(i)) Mod 255
    temp = s(i)
    s(i) = s(j)
    s(j) = temp
Next
'Drop n bytes from keystream
x = 0
y = 0
For i = 1 To 3072
    x = (x + 1) Mod 255
    y = (y + s(x)) Mod 255
    temp = s(x)
    s(x) = s(y)
    s(y) = temp
Next
'Encode/Decode
For i = 1 To Len(sMessage)
    x = (x + 1) Mod 255
    y = (y + s(x)) Mod 255
    temp = s(x)
    s(x) = s(y)
    s(y) = temp
    fRunRC4 = fRunRC4 & Chr(s((s(x) + s(y)) Mod 255) Xor Asc(Mid(sMessage, i, 1)))
Next

End Function

CrossTab Query

شرح بارکد 128 به زبان ساده

نوارهای عمودی مشکی در شکل زیر بعنوان Bar یاد شده و نوارسفید بعنوان Space 

این بارکد ۷ سکشن دارد 

۱-منطقه فراخ Quiet Zone

۲-نماد شروع Start Symbol

۳-کد کردن داده Encode Data

۴-نماد بررسی یا چک سیمبل و الزامیست Check Symbol

۵-نماد پایان Stop Symbol

۱-منطقه فرخ Quiet Zone 

نماد بررسی یا چک سیمبل از جمع حاصلضربهای  Value هر کاراکتر در شماره ترتیب آن بدست می آید . 

کد ۱۲۸ شامل ۱۰۸ نماد است : ۱۰۳ نماد داده ۳ نماد شروع و ۲ نماد پایان ( طبق جدول )  . هر نماد حاوی ۳ میله سیاه  و ۳ میله سفید با عرض های متفاوت است . هر میله و فضای خالی ۱ تا ۴ واحد پهنا دارد. جمع عرض های ۳ میله سیاه و ۳ میله سفید ۱۱ واحد یا ماژول هستند .

حداقل عرض Quiet Zone در سمت چپ و راست بارکد 10x است، x حداقل عرض ماژول است و وجودش در سمت چپ و راست بارکد کاملا اجباری است 

هر Symbol در بارکد از ۳ میله ( Bar ) و ۳ فاصله یا فضای خالی ( Space) تشکیل شده است ، هر میله یا فاصله ۱ ۲ ۳ یا ۴ واحد پهنا دارد. جمع عرض میله ها باید زوج باشد ( ۴ ۶ یا ۸ ) . جمع عرض فاصله ها بایستی فرد باشد ( ۳ ۵ یا ۷ )  و در کل ۱۱ واحد در هر Symbol 

برای مثال رمزنگاری اسکی کاراکتر ۰ میتواند بعنوان 10011101100 ( مطابق جدول ) نمایش داده شود جایی که رشته 1 یک بار است و 0 هم یک فاصله . 1 اگر تک باشد بعنوان نازک ترین خط در بارکد است و ۳ تا 1 نشان میدهد ۳ برابر یک بار ضحامت دارد بدین معنا که ضخیم تر از آن است 

  جدول Symbol ها ستون ویدز و پترن Code_128

تصویر زیر بیانگر توضیحات بالاست ( AB )

EditRecord Data Block

editrecord-data-block

Data Macro : Before Change

SetLocalVar

این اکشن یک متغیر موقت میسازد و آن را به یک مقدار مشخص تنظیم می نماید 

متغیرهایی که توسط  این اکشن ساخته میشوند فقط در ماکرو میتوانند استفاده شوند . در غیر از ماکرو در Event ، فرم یا گزارش از اکشن SetTempVar استفاده بنمائید .

زمانیکه متغیر موقت ساخته شدشما می توانید آنرا به یک Expression ارجاع بدهید. برای مثال اگر متغیرموقتی با نام TotalAmount ایجادکردید با استفاده از نوشتار زیر می توانید از متغیر بعنوان منبع کنترل یک Text Box استفاده بنمائید

LocalVars!TotalAmount=

در یک Data Macro ، لازم نیست از مجموعه LocalVars استفاده کنید تا به یک متغیر مراجعه کنید. به عنوان مثال ، اگر یک متغیر موقت را در یک Macro Data با نام TotalAmount ایجاد کردید ، می توانید از متغیر به عنوان منبع کنترل یک جعبه متن با استفاده از نحو زیر استفاده کنید:

  [TotalAmount]=

ImageProcess Object

زنجیره فیلتر را مدیریت می کند. یک شی ImageProcess را می توان با استفاده از "WIA.ImageProcess" به عنوان ProgID در فراخوانی به CreatObject ایجاد کرد.

مثال Image Resize

Dim Thumb 'As ImageFile
Dim Img 'As ImageFile

Dim IP 'As ImageProcess
"Img ="WIA.ImageFile
"IP ="WIA.ImageProcess
"Thump="WIA.ImageFile

Thumb.LoadFile "C:\WINDOWS\Web\Wallpaper\BlissThumb.bmp"
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"

Set IP.Filters(1).Properties("ImageFile") = Thumb
IP.Filters.Add IP.FilterInfos("Stamp").FilterID
IP.Filters(1).Properties("Top") = Img.Height - Thumb.Height
IP.Filters(1).Properties("Left") = Img.Width - Thumb.Width

Set Img = IP.Apply(Img)

Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissStamp.bmp"

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

IP.Filters.Add IP.FilterInfos("RotateFlip").FilterID IP.Filters(1).Properties("RotationAngle") = 90

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

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

4/IP.Filters(1).Properties("Left") = Img.Width

4/IP.Filters(1).Properties("Top") = Img.Height

 IP.Filters(1).Properties("Right") = Img.Width/ 4

 IP.Filters(1).Properties("Bottom") = Img.Height / 4

FilterInfos Object

شامل مجموعه ای از همه اشیاء FilterInfo موجود است. برای جزئیات بیشتر در مورد دسترسی به شی FilterInfos ، از ویژگی FilterInfos (ImageProcess) در شی ImageProcess دیدن کنید.

To get further documentation for ImageProcess, we can just "ask it"! Run this:
()Sub List_WIA_ImageProcess_Filters
    Dim f As Object, x As Long
    For Each f In CreateObject("WIA.ImageProcess").FilterInfos
        x = x + 1
        Debug.Print "#" &x &": " &f.Name &" = " &f.Description &vbLf
    Next f
End Sub

RotateFlip = Rotates in 90 degree increments and Flips, horizontally or vertically.

RotationAngle  - Set the RotationAngle property to 90, 180, or 270 if you wish
                 to rotate, otherwise 0 [the default]
FlipHorizontal - Set the FlipHorizontal property to True if you wish to flip
                 the image horizontally, otherwise False [the default]
FlipVertical   - Set the FlipVertical property to True if you wish to flip
                 the image vertically, otherwise False [the default]
FrameIndex     - Set the FrameIndex property to the index of a frame if you
                 wish to modify a frame other than the ActiveFrame,
                 otherwise 0 [the default]

Crop = Crops the image by the specified Left, Top, Right, and Bottom margins.


Left       - Set the Left property to the left margin (in pixels)
             if you wish to crop along the left, otherwise 0 [the default]
Top        - Set the Top property to the top margin (in pixels)
             if you wish to crop along the top, otherwise 0 [the default]
Right      - Set the Right property to the right margin (in pixels)
             if you wish to crop along the right, otherwise 0 [the default]
Bottom     - Set the Bottom property to the bottom margin (in pixels)
             if you wish to crop along the bottom, otherwise 0 [the default]
FrameIndex - Set the FrameIndex property to the index of a frame if you
             wish to modify a frame other than the ActiveFrame,
             otherwise 0 [the default]


Scale = Scales image to the specified Maximum Width and Maximum Height preserving
Aspect Ratio if necessary.

MaximumWidth        - Set the MaximumWidth property to the width (in pixels)
                      that you wish to scale the image to.
MaximumHeight       - Set the MaximumHeight property to the height (in pixels)
                      that you wish to scale the image to.
PreserveAspectRatio - Set the PreserveAspectRatio property to True
                      [the default] if you wish to maintain the current aspect
                      ration of the image, otherwise False and the image will
                      be stretched to the MaximumWidth and MaximumHeight
FrameIndex          - Set the FrameIndex property to the index of a frame if
                      you wish to modify a frame other than the ActiveFrame,
                      otherwise 0 [the default]

Stamp = Stamps the specified ImageFile at the specified Left and Top coordinates.


ImageFile  - Set the ImageFile property to the ImageFile object that you wish
             to stamp
Left       - Set the Left property to the offset from the left (in pixels)
             that you wish to stamp the ImageFile at [default is 0]
Top        - Set the Top property to the offset from the top (in pixels) that
             you wish to stamp the ImageFile at [default is 0]
FrameIndex - Set the FrameIndex property to the index of a frame if you wish to
             modify a frame other than the ActiveFrame, otherwise 0
             [the default]

Exif = Adds/Removes the specified Exif Property.


Remove     - Set the Remove property to True if you wish to remove the
             specified Exif property, otherwise False [the default] to add the
             specified exif property
ID         - Set the ID property to the PropertyID you wish to Add or Remove
Type       - Set the Type property to indicate the WiaImagePropertyType of the
             Exif property you wish to Add (ignored for Remove)
Value      - Set the Value property to the Value of the Exif property you wish
             to Add (ignored for Remove)
FrameIndex - Set the FrameIndex property to the index of a frame if you
             wish to modify a frame other than the ActiveFrame,
             otherwise 0 [the default]

#6: Frame = Adds/Removes the specified Frame.


Remove     - Set the Remove property to True if you wish to remove the
             specified FrameIndex, otherwise False [the default] to Insert the
             ImageFile before the specified FrameIndex
ImageFile  - Set the ImageFile property to the ImageFile object whose
             ActiveFrame that you wish to add (ignored for Remove)
FrameIndex - For Remove, set the FrameIndex property to the index of the frame
             you wish to remove, otherwise for add, set the FrameIndex to the
             index of the frame to insert the ImageFile before, otherwise 0
             [the default] to append a frame from the ImageFile specified


#7: ARGB = Updates the image bits with those specified.

ARGBData -   Set the ARGBData property to the Vector of Longs that represent
             the ARGB data for the specified FrameIndex (the width and height
             must match)
FrameIndex - Set the FrameIndex property to the index of the frame whose ARGB
             data you wish to modify, otherwise 0 [the default] to modify the
             ActiveFrame


#8: Convert = Converts the resulting ImageFile to the specified type.

FormatID    - Set the FormatID property to the supported raster image format
              desired, currently you can choose from wiaFormatBMP,
              wiaFormatPNG, wiaFormatGIF, wiaFormatJPEG, or wiaFormatTIFF
Quality     - For a JPEG file, set the Quality property to any value from 1 to
              100 [the default] to specify quality of JPEG compression
Compression - For a TIFF file, set the Compression property to CCITT3, CCITT4,
              RLE or Uncompressed to specify the compression scheme,
              otherwise LZW [the default]

CommonDialog.ShowAcquireImage method

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

CommonDialog object

شامل تمام روشهایی است که یک رابط کاربر را نمایش می دهد. کنترل CommonDialog یک کنترل در زمان اجرا نامرئی است که می توانید با استفاده از "WIA.CommonDialog" به عنوان ProgID در فراخوانی به CreatObject یا با رها کردن یک شی CommonDialog روی یک فرم ایجاد کنید.

Methods
The CommonDialog object has these methods.
TABLE 1
Method
Description
ShowAcquireImage
Displays one or more dialog boxes that enable the user to acquire an image from a hardware device.
ShowAcquisitionWizard
Starts the Scanner and Camera Wizard.
ShowDeviceProperties
Displays the Properties dialog box for the specified Device.
ShowItemProperties
Displays the Properties dialog box for the specified Item.
ShowPhotoPrintingWizard
Starts the Photo Printing Wizard with the absolute path of a specific file or Vector of absolute paths to files.
ShowSelectDevice
Displays a dialog box that enables the user to select a hardware device for image acquisition.
ShowSelectItems
Displays a dialog box that enables the user to select an Item for transfer from a hardware device for image acquisition.
ShowTransfer
Displays a Progress dialog box while transferring the specified Item to the local computer.

ImageFile object

Holds images transferred to your computer when you call Transfer or ShowTransfer. The ImageFile object is a container. It also supports image files through LoadFile. An ImageFile object can be created using 

WIA.ImageFile" as the ProgID in a call to CreateObject"

Methods

The ImageFile object has these methods.

TABLE 1

Method	Description
LoadFile	Loads the ImageFile object with the specified file.
SaveFile	Saves the ImageFile object to the specified file.

Properties

used as variable say ADFstatus that reads whether there is still a paper in the feeder and used this to create a while loop.(wiaScanner.Properties.Item("3087")). I then saved each scanned image separately, and it causes the ADF scanner to stop after each scan instead of scanning all papers at once.

("createobject("WIA.ImageFile

Dim wiaImg As WIA.ImageFile

ADFStatus=wiaScanner.Properties.Item("3087").Value

counter = 0

While ADFStatus 

counter = counter + 1

Set wiaImg=wiaScanner.Items(1).Transfer(WIA.FormatID.wiaFormatBMP)

wiaImg.SaveFile ("C:\Test\" & counter & ".bmp")

Set wiaImg=Nothing

ADFStatus=wiaScanner.Properties.Item("3087").Value Wend

Indicates the file format of an image as String versions of GUIDs.

TABLE 1

Constant/value	Description
wiaFormatBMP {B96B3CAB-0728-11D3-9D7B-0000F81EF32E}	FormatID for the Windows BMP format.
wiaFormatPNG {B96B3CAF-0728-11D3-9D7B-0000F81EF32E}	FormatID for the PNG format.
wiaFormatGIF {B96B3CB0-0728-11D3-9D7B-0000F81EF32E}	FormatID for the GIF format.
wiaFormatJPEG {B96B3CAE-0728-11D3-9D7B-0000F81EF32E}	FormatID for the JPEG format.
wiaFormatTIFF {B96B3CB1-0728-11D3-9D7B-0000F81EF32E}	FormatID for the TIFF format.

فیلتر در فرم با ماکرو SetFilter

ساخت باتن ( در نمای دیزاین ) ---> پراپرتی شیت ---> تب Event ---> کمبو باکس رویداد کلیک ---> Embedded Macro

طبق مثال زیر وقتی در تکست باکس ۲ از فرم جاری که Room هست آیدی مشخصی را تایپ کنید و روی باتنی که ساخته اید کلیک کنید چنانچه در منبع موجودباشد در فرم نمایش داده خواهد شد . 

اگر این ماکرو ( که به فرم چسبیده و قابل ترجمه به VBA نیست ) قرار باشد سابفرمی در فرم را فیلتر نماید باید نام سابفرم هم برده شود فرضا MainForm فرم ۱ است و SubForm ساب ۱ نتیجتا ساختار نوشتاری آن بدین شکل خواهد بود 

Forms!Form1!Sub1!Id=Forms!Form1!Text2

یکی از روش های حذف فیلتر در VBA 

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

()Private Sub Remove_Filter_Button_Click

Forms!frm_WO_Status_Form!subfrm_WO_Status_Form.Form.FilterOn = False

End Sub

تعیین شماره رکورد در رکوردست

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

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

مثال زیر از خاصیت AbsolutePosition برای رهگیری ( دنبال کردن ) پیشرفت لوپ که تمام رکوردهای رکوردست را میشمرد استفاده می نماید 

برگرفته شده از سایت آفیس 

()Sub AbsolutePositionX

Dim dbsNorthwind As Database

Dim rstEmployees As Recordset

Dim strMessage As String

("Set dbsNorthwind=OpenDatabase("Northwind.mdb

.AbsolutePosition only works with dynasets or snapshots'

Set 

(rstEmployees=dbsNorthwind.OpenRecordset("Employees",dbOpenSnapshot

With rstEmployees

 Populate Recordset'

MoveLast.

MoveFirst.

 Enumerate Recordset'

Do While Not .EOF 

 Display current record information. Add 1 to AbsolutePosition value'

. because it is zero-based"

strMessage = "Employee: " & !LastName & vbCr & "(record " & (.AbsolutePosition + 1) & _ " of " & .RecordCount & ")"

If MsgBox(strMessage,vbOKCancel)=vbCancel Then Exit Do 

MoveNext 

Loop. 

Close.

End With 

dbsNorthwind.Close 

End Sub

Concatenate Column

مثال در سایت زیر دقیق بخوانید و اجرا کنید ( هر آنچه نمی دانید را در google سرچ کرده و با یادگیری از اکسس لذت ببرید

Concatenate-Column-Values-from-Multiple-Rows-into-a-Single-Column-with-Access

مثالی دیگر 

Public Function ConcatRelated(strField As String, _ strTable As String, _ Optional strWhere As String, _ Optional strOrderBy As String, _ Optional strSeparator = ", ") As Variant

Dim rs As DAO.Recordset

Dim rsMV As DAO.Recordset

'Multi-valued field recordset

Dim strSql As String

SQL statement'

Dim strOut As String

Output string to concatenate to'

Dim lngLen As Long

Length of string'

Dim bIsMultiValue As Boolean

Flag if strField is a multi-valued field'

Initialize to Null'

ConcatRelated = Null 

(Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset

(Determine if the requested field is multi-valued (Type is above 100'

(bIsMultiValue = (rs(0).Type > 100

Do While Not rs.EOF

If bIsMultiValue Then 

For multi-valued field, loop through the values'

Set rsMV = rs(0).Value

Do While Not rsMV.EOF

If Not IsNull(rsMV(0)) Then

strOut = strOut & rsMV(0) & strSeparator

End If

rsMV.MoveNext

Loop

Set rsMV = Nothing

ElseIf Not IsNull(rs(0)) Then

strOut = strOut & rs(0) & strSeparator

End If

rs.MoveNext

Loop

rs.Close

Clean up'

Set rsMV = Nothing

Set rs = Nothing

Exit Function 

For the example above, you could set the  ControlSource of a text box to

=

"ConcatRelated("OrderDate", "tblOrders","CompanyID

[CompanyID] & 

or in a query:

"SELECT CompanyName, ConcatRelated("OrderDate

([tblOrders", "CompanyID = " & [CompanyID",

FROM tblCompany

ماکزیمم یک گروپ در اکسل

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

تغییر نام و اضافه کردن دکمه

تغییر نام کامند باتن با تنظیم خاصیت Caption انجام میگیرد چه در Property Sheet و خاصیتی بنام کپشن در حالت دیزاین فرم چه در محیط VB اکسس ،  ولی ساخت دکمه ی جدید امکانپذیر نیست مگر اینکه فرم در حالت دیزاین بطور Hidden باز شده و با CreateControl و آرگومان هایش آنرا (  Left Right Width Height ) ایجاد کرد ولی اگر دیتابیس به ACCDE تبدیل شود چون دیزاین بسته میشود اینکار با عدم موفقیت روبرو خواهد شد مگر اینکه باتن هایی در فرم ایجاد و VISIBLE=FALSE شود و بعد زمان فشردن دکمه ی دیگر آن / آنها را با تنظیم کردن خاصیت VISIBLE به TRUE مشاهده نمود ، در ضمن خاصیت های Left یا Top هم میتواند نسبت به جابجایی آنها اقدام نماید

Remove Unprotect Sheet Of Excel File

VLOOKUP در اکسل توسط MATCH و INDEX

ASME PCC1- 2010

ScrollBar

At the picture below you can see what I've already done. Left scrollbar is a system scrollbar, right one - custom scrollbar.

FVertBar: Boolean; FPressedBtn1, FPressedBtn2, FSelectedBtn1, FSelectedBtn2: Boolean; FBarBmp, FBtn1Bmp, FBtn2Bmp: TBitmap; MainDC: hDC; 

FBarBmp.Free; FBtn1Bmp.Free; FBtn2Bmp.Free;


Case WM_ENABLE ' WM_SHOWWINDOW
Width=100
Height=80

FSelectedBtn1=false
FSelectedBtn2=false
FPressedBtn1=false
FPressedBtn2=false

(FBarBmp=LoadImageA(0,"D:\...bmp",0,16,16,&H10
=FBtn1Bmp
=FBtn2Bmp

Case WM_DESTROY

DeleteObject FBarBmp
DeleteObject FBtn1Bmp
DeleteObject FBtn2Bmp

Case WM_NCCALCIZE

decrease width to create non-client area'

(Dec(Message.CalcSize_Params.rgrc(0).Right,17

FVertBar= true

Case WM_NCPAINT

(MainDC=GetWindowDC(Hwnd

(if FVertBar then PaintScrollBarVert(MainDC

if FVertBar then 

PaintButtonVert1 MainDC

PaintButtonVert2 MainDC

End if 

Enf if 

ReleaseDC Handle, MainDC

Case WM_NCMOUSEMOVE

GetCursorPos pt

ScreenToClient hwnd,pt

Top Vert Button'

(Rect(Width - 17 - 2, ClientRect.Top, Width - 2, 17

if PtInRect(Crect,pt) then

FSelectedBtn1= true

else

FSelectedBtn1=false

End If 

bottom vert button '

Rect(Width - 17 - 2, ClientRect.Bottom - 17, Width - 2,

(ClientRect.Bottom + 17,

if PtInRect(Crect,pt)   then

FSelectedBtn2=true

else

FSelectedBtn2=false

End if 

SendMessageA hwnd,WM_NCPAINT,1, 0

Cas WM_NCLBUTTONDOWN

GetCursorPos pt 

ScreenToClient hwnd,pt

'Top Vert Button

Rect(Width - 17 - 2, ClientRect.Top, Width - 2, 17)

if PtInRect(Crect,pt) then

FPressedBtn1=true

End If 

'bottom vert button 

Rect(Width - 17 - 2, ClientRect.Bottom - 17, Width - 2, ClientRect.Bottom + 17)

if PtInRect(Crect,pt)   then

FPressedBtn2=true

End if 

SendMessageA hwnd,WM_NCPAINT,1, 0

Case WM_NCLBUTTONUP

FPressedBtn1=false

FPressedBtn2 =false 

SendMessageA hwnd,WM_NCPAINT,1, 0

(PaintScrollBarVert(hDC

FBarBmp.Width= 17

FBarBmp.Height=ClientRect.Bottom

FBarBmp.Canvas.Brush.Color=clLime FBarBmp.Canvas.FillRect(FBarBmp.Canvas.ClipRect)

BitBlt(MainDC,Width-17-2,ClientRect.Top + 2,FBarBmp.Width,FBarBmp.Height, FBarBmp.Canvas.Handle,0, 0,SRCCOPY) 

(PaintButtonVert1(hDC

FBtn1Bmp.Width=17

FBtn1Bmp.Height=17

if not FSelectedBtn1 then FBtn1Bmp.Canvas.Brush.Color=clRed

End if 

if FSelectedBtn1 then FBtn1Bmp.Canvas.Brush.Color =clBlue

End if 

if FSelectedBtn1 and FPressedBtn1 then FBtn1Bmp.Canvas.Brush.Color=clPurple

FBtn1Bmp.Canvas.FillRect(FBtn1Bmp.Canvas.ClipRect)

BitBlt(DC, Width - 17 - 2, ClientRect.Top + 2, FBtn1Bmp.Width, FBtn1Bmp.Height, FBtn1Bmp.Canvas.Handle, 0, 0, SRCCOPY)

End if 

(PaintButtonVert2(hDC

FBtn2Bmp.Width=17

FBtn2Bmp.Height=17

if not FSelectedBtn2 then FBtn1Bmp.Canvas.Brush.Color=clRed

End if 

if FSelectedBtn2 then FBtn1Bmp.Canvas.Brush.Color=clBlue

End if 

if FSelectedBtn2 and FPressedBtn2 then FBtn1Bmp.Canvas.Brush.Color=clPurple

FBtn1Bmp.Canvas.FillRect(FBtn1Bmp.Canvas.ClipRect)

BitBlt(DC, Width - 17 - 2, ClientRect.Bottom - 17 + 2, FBtn1Bmp.Width,FBtn1Bmp.Height, FBtn1Bmp.Canvas.Handle, 0, 0, SRCCOPY)

End if 

---

مربوط به مثال بالا نیست 

ساختار WINDOWPLACEMENT

WINDOWPLACEMENT structure

Contains information about the placement of a window on the screen.

Type WINDOWPLACEMENT
length As Long
flags As Long
showCmd As Integer
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
rcDevice As RECT
End Type

Of course you should measure/obtain the correct border size from your window style by using methods like GetSystemMetrics or GetThemeMetric, its a very simple task. I just wanted to demonstrate how you can change the border size of your frame when switching between the window states.

The size and positions of the caption buttons are now correct, as you can see here

---

GetWindowPlacement function

Retrieves the show state and the restored, minimized, and maximized positions of the specified window.

Parameters

hWnd

Type: HWND

A handle to the window.

lpwndpl

Type: WINDOWPLACEMENT*

A pointer to the WINDOWPLACEMENTstructure that receives the show state and position information. Before calling GetWindowPlacement, set the lengthmember to sizeof(WINDOWPLACEMENT). GetWindowPlacement fails if lpwndpl-> length is not set correctly.

Return Value

Type: Type: BOOL

If the function succeeds, the return value is nonzero.


Remarks

The flags member of WINDOWPLACEMENTretrieved by this function is always zero. If the window identified by the hWnd parameter is maximized, the showCmd member is SW_SHOWMAXIMIZED. If the window is minimized, showCmd is SW_SHOWMINIMIZED. Otherwise, it is SW_SHOWNORMAL.

The length member of WINDOWPLACEMENTmust be set to sizeof(WINDOWPLACEMENT). If this member is not set correctly, the function returns FALSE. For additional remarks on the proper use of window placement coordinates, see WINDOWPLACEMENT.

---

VSCROLL.HSCROLL ایجاد دو باتن در ناحیه ی NonClient لیست باکس

https://www.codeproject.com/Articles/1293/Control-Subclassing

هنوز تست نشده  ولی نحوه ی کار به این شکل است که اندازه ی ناحیه Client  رو عوض میکنند تا دو مستطیل با حالت باتن در پائین و بالای آن بکشند ، بعنوان Scroll Up/Down و NCHITTEST هم  زمانی که ماوس روی آن قسمت ها قرار می گیرد یا موقعیت عوض میشود عدد ثابتی رو بر میگردونه و طبق همون و NCLBUTTONDOWN تابعی رو صدا میزنن که حالت PUSH بگیره وقتی فشرده شه یا  به حالت اولش برگرده .

در NCCALCSIZE و WPARAM=1 اندازه ی دوباره داده میشود البته SWP_FRAMECHANGED نباید فراموش شود بعد از ساب کلاس کردن فرضا 

Private listboxProc As LongPtr

listboxProc=0

HookWindow

در HOOKPROC زمانیکه پیام  HCBT_CREATEWND دریافت میشود  برای هنگ نکردن یا عدم Crash باید اگر listbox=0 و wparam  برابر با کلاس پنجره  با تابع GetClassName و نام پنجره ( منظور کپشن آن ) همان نام پنجره  (قلاب شده) شد منظور  با GETWINDOWTEXT  به تابع WndProc ریفر داده شود جهت تسخیر پیام های ارسالی 

WndProc

Select Case Msg 

 Case WM_ENABLE  ' WM_SHOWWINDOW

listboxproc=SetWindowLongPtrA(hlist,GWL_WNDPROC,AddressOf 

(fnlist

SetWindowpos 0,0,0,0,0,0,SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_FRAMECHANGED

WM_DESTROY

SetWindowLongPtrA hwnd,GWL_WNDOROC,listboxProc

End Function 

تابعی برای Capture کردن یا تسخیر پیام های دریافتی  ( لیست باکس )

Function fnlist(ByVal hwnd As LongPtr,ByVal Msg As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As LongPtr 

Dim nccsp As NCCALCSIZE_PARAMS

Select Case Msg

Case WM_NCCALCSIZE

CallWindProcA listboxProc,hwnd,Msg,wParam,lParam

Use CopyMemory'

Case WM_NCPAINT

End Select

(fnlist=CallWindProcA(listboxProc,hwnd,Msg,wParam,lParam

End Function 

در NCPAINT کشیدن Scroll انجام میشود 

SetBkColor(COLORREF crBkColor,COLORREF 

(crSelectedColor

{

Deletes previous brush. Must do in order to create a'

new one '

DeleteObject m_BkBrush

Sets the brush the specified background color' 

m_BkBrush=CreateSolidBrush(crBkColor)

Invalidate  'Forces Redraw

()Function DrawBorders

GetClientRect hlist,Crect

InflateRect Crect,GetSystemMetrics(SM_CXEDGE), GetSystemMetrics(SM_CYEDGE)

'Since we'll be using m_bOver, let's 'initialize it. Add m_bOver = 'FALSE; on PreSubclassWindow.

if (m_bOver) Then 

DrawEdge hdc,Crect,EDGE_BUMP,BF_RECT

Else

DrawEdge hdc,Crect,EDGE_SUNKEN,BF_RECT

End If 

ReleaseDC hdc

End Function 

WM_MOUSLEAVE

m_bOver=FALSE

()DrawBorders

if (!m_bOver)

m_bOver=TRUE 'Now the mouse is over DrawBorders() 'Self explanatory //Add TRACKMOUSEEVENT track 'Declares structure

(track.cbSize=sizeof(track

track.dwFlags=TME_LEAVE 'Notify us when the mouse leaves

 track.hwndTrack=m_hWnd 'Assigns this window's hwnd 

TrackMouseEvent &track

MouseMove

'If m_bOver==FALSE,and this function is 'called, it means that the mouse entered. 

if (!m_bOver) Then 

m_bOver=TRUE 'Now the mouse is over

DrawBorders() ' Self explanatory 

We then set them to an initial value under PreSubclassWindow:

m_bOver = FALSE;

m_ItemHeight=18; m_crTextHlt=GetSysColor(COLOR_HIGHLIGHTTEXT);

m_crTextClr=GetSysColor(COLOR_WINDOWTEXT);

m_HBkColor=GetSysColor(COLOR_HIGHLIGHT);

m_BmpWidth=16;

m_BmpHeight=16;

 : MeasureItem

lpMeasureItemStruct->itemHeight=m_ItemHeight;

4. Scrollbars

For simplicity purposes. the scrollbars that we are going to make are going to be static, always shown regardless of whether they are needed. I don't think we are using the correct term since they don't have bars but who cares. As we all know, we must draw them. However, the problem is how to do it so that it is within the listbox rect and does not cover any item. There's a simple solution, we can resize the client area. This can be done by receiving the message WM_NCCALCSIZE. Add a function for it, and we get:

lpncsp->rgrc[0].top += 16; //Top

lpncsp->rgrc[0].bottom -= 16; //Bottom

WM_NCPAINT

static BOOL before=FALSE

if (!before) Then

SetWindowPos(NULL,0,0,0,0,SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE before=TRUE

()DrawBorders

(DrawScrolls(UINT WhichOne, UINT State

()pDC=GetDC

CRect rect

GetClientRect hwnd,Crect

 

if (IsWindowEnabled())State=SC_DISABLED; //Expands the so that it does not draw over the borders

Crect.left=Crect.left-GetSystemMetrics(SM_CYEDGE) Crect.right= Crect.right+GetSystemMetrics(SM_CXEDGE)

(if (WhichOne==SC_UP

 

rect.bottom=rect.top-GetSystemMetrics(SM_CXEDGE) rect.top=rect.top-16-GetSystemMetrics(SM_CXEDGE)

Draws the scroll up '

DrawFrameControl pDC,Crect,DFC_SCROLL,State Or DFCS_SCROLLUP)

else

Needs to draw down

rect.top=rect.bottom+GetSystemMetrics(SM_CXEDGE) rect.bottom=rect.bottom+16+GetSystemMetrics(SM_CXEDGE); DrawFrameControl pDC,Crect,DFC_SCROLL,State Or DFCS_SCROLLDOWN

ReleaseDC pDC

pubic const SC_UP=2

public const SC_DOWN=3

WM_Enable 

'SC_NORMAL will be changed to 'SC_DISABLED if the window is disabled DrawScrolls(SC_UP,SC_NORMAL) DrawScrolls(SC_DOWN,SC_NORMAL);

(OnNcLButtonDown(UINT nHitTest, CPoint point

if (nHitTest=HTVSCROLL) 'Up scroll Pressed DrawScrolls(SC_UP,SC_PRESSED) 'Scroll up 1 line SendMessage(WM_VSCROLL,MAKEWPARAM(SB_LINEUP,0),0)

SetTimer(1,100,NULL)'Sets the timer ID 1

else if (nHitTest==HTHSCROLL)'Down scroll Pressed DrawScrolls(SC_DOWN,SC_PRESSED) ' Scroll down 1 line SendMessage(WM_VSCROLL,MAKEWPARAM(SB_LINEDOWN,0),0) SetTimer(2,100,NULL) 'Sets the timer ID 2

 

(OnTimer(UINT nIDEvent

(result=GetKeyState(VK_LBUTTON

if (nIDEvent==1) ' Up timer If it returns negative then it is pressed

(if (result<0

SendMessage(WM_VSCROLL,MAKEWPARAM(SB_LINEUP,0),0)

else ' No longer pressed

(KillTimer(1

( DrawScrolls(SC_UP,SC_NORMAL

else 'Down timer 

'If it returns negative then it is pressed

(if (result<0

SendMessage(WM_VSCROLL,MAKEWPARAM(SB_LINEDOWN,0),0)

else

(KillTimer(2

(DrawScrolls(SC_DOWN,SC_NORMAL

(OnNcHitTest(CPoint point

CRect rect,top,bottom

GetWindowRect hwnd,Crect

ScreenToClient hwnd,Crect

top=bottom=rect

top.bottom=rect.top+16

bottom.top=rect.bottom-16

Obtains where the mouse is '

UINT 

(where=CListBox::OnNcHitTest(point

Converts the point so its relative to the client area'

ScreenToClient hwnd,&point

if (where == HTNOWHERE) 'If mouse is not in a place it recognizes 

if (PtInRect(top,point)) 'Check to see if the mouse is on the top 

where=HTVSCROLL

else if (PtInRect(bottom,point)) 'Check to see if its on the bottom 

where=HTHSCROLL

return where ' Returns where it is 

---

WM_NCLBUTTONDOWN 0x00A1

Parameters

wParam

The hit-test value returned by the DefWindowProc function as a result of processing the WM_NCHITTEST message. For a list of hit-test values, see WM_NCHITTEST.

lParam

A POINTS structure that contains the x- and y-coordinates of the cursor. The coordinates are relative to the upper-left corner of the screen.

---

---

case WM_NCCALCSIZE

ncParams=(LPNCCALCSIZE_PARAMS) lParam

ncParams.rgrc(0).top=ncParams.rgrc(0).top4
ncParams.rgrc(0).left=ncParams.rgrc(0).left+4
ncParams.rgrc(0).bottom=ncParams.rgrc(0).bottom-4
ncParams.rgrc(0).right=ncParams.rgrc(0).right-4
Function=0


case WM_NCPAINT

Crect As RECT

GetWindowRect hWnd, Crect
(hdc=GetDC(hwnd
((hpen=CreatePen(PS_INSIDEFRAME,4, RGB(255, 0, 0

(holdobj=SelectObject(dc,hpen

width=Crect.right-Crect.left
height=Crect.bottom-Crect.top
Rectangle hdc,0,0,width,height SelectObject hdc,holdobj
ReleaseDC hWnd, dc
DeleteObject hpen
Function=0

case WM_NCACTIVATE

RedrawWindow hWnd,0,0, RDW_UPDATENOW???
Function=0

---

lpncsp->rgrc[0].right -= 100