برنامه لیگ برتر ایران تحت اكسس سال 90-91

توسط این برنامه می توانید نتایج بازیهای لیگ ایران را وارد و جدول نهایی را مشاهده نمایید.
از امكانات قابل توجه این برنامه می توان به نمایش جدول تا هفته ای خاص، امكان جستجوی نتایج تیم دلخواه و بازیهای آینده تیم دلخواه، امكان جستجوی نتیجه بازی دو تیم دلخواه و ... اشاره نمود.

دوستان توجه نمایند كه برای نمایش بهتر برنامه بهتر است فونت نازنین را كه پیوست نموده ام در سیستم خود نصب كنند.

نكته بسیار مهم: حتما قبل از اجرای برنامه یك فایل اكسس به دلخواه باز كرده و از منوی tools گزینه macro و سپس security را انتخاب كنید و در پنجره باز شده گزینه Low را انتخاب كنید.
دوستانی هم كه از Office 2007 استفاده می كنند به ترتیب زیر عمل كنند:
یك فایل اكسس دلخواه باز نموده و دكمه access option را بفشارید.از قسمت trust sender گزینه trust sender setting را انتخاب كرده و macro setting را برگزیده و حالت enable all macro را انتخاب كنید.

قراردادن این برنامه در سایتهای دیگر با ذكر نام منبع بلامانع است.

پسورد فایل : shahramvb

دانلود برنامه
دانلود فونت نازنین

برچسب ها: برنامه لیگ برتر ، تحت اكسس ، سال 90 ،

Eject فلش مموری

با قطعه كد زیر می توان نام درایو فلش مموری را به تابع داد و تابع فلش مموری را Eject میكند.در واقع همان كاری كه ما هنگام خارج كردن فلش مموری از سیستم انجام می دهیم و برق usb را قطع می كنیم.

Private Declare Function CM_Get_DevNode_Status Lib "setupapi.dll" _
(lStatus As Long, lProblem As Long, ByVal hDevice As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CM_Get_Parent Lib "setupapi.dll" _
(hParentDevice As Long, ByVal hDevice As Long, ByVal dwFlags As Long) As Long

Private Declare Function CM_Locate_DevNodeA Lib "setupapi.dll" _
(hDevice As Long, ByVal lpDeviceName As Long, ByVal dwFlags As Long) As Long

Private Declare Function CM_Request_Device_EjectA Lib "setupapi.dll" _
(ByVal hDevice As Long, lVetoType As Long, ByVal lpVetoName As Long, _
ByVal cbVetoName As Long, ByVal dwFlags As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, _
ByVal lpdwReserved As Long, lpdwType As Long, lpData As Any, _
lpcbData As Long) As Long

Private Sub Command1_Click()
    '~~> Type the Name of the USB Drive
    Call SafelyRemove("h:")
   ' Label1.Caption = "DONE"
End Sub
'~~> Safely remove USB flash drive
Public Function SafelyRemove(ByVal pstrDrive As String) As Boolean
    Const DN_REMOVABLE = &H4000
    Dim strDeviceInstance As String, lngDevice As Long, lngStatus As Long
    Dim lngProblem As Long, lngVetoType As Long, strVeto As String * 255

    pstrDrive = UCase$(Left$(pstrDrive, 1)) & ":"
    strDeviceInstance = StrConv(GetDeviceInstance(pstrDrive), vbFromUnicode)

    If CM_Locate_DevNodeA(lngDevice, StrPtr(strDeviceInstance), 0) = 0 Then
        If CM_Get_DevNode_Status(lngStatus, lngProblem, lngDevice, 0) = 0 Then
            Do While Not (lngStatus And DN_REMOVABLE) > 0
                If CM_Get_Parent(lngDevice, lngDevice, 0) <> 0 Then Exit Do
                If CM_Get_DevNode_Status(lngStatus, lngProblem, lngDevice, 0) _
                <> 0 Then Exit Do
            Loop
            If (lngStatus And DN_REMOVABLE) > 0 Then SafelyRemove = _
            (CM_Request_Device_EjectA(lngDevice, lngVetoType, _
            StrPtr(strVeto), 255, 0) = 0)
        End If
    End If
End Function

Private Function GetDeviceInstance(pstrDrive As String) As String
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const KEY_QUERY_VALUE = &H1
    Const REG_BINARY = &H3
    Const ERROR_SUCCESS = 0&

    Dim strKey As String, strValue As String, lngHandle As Long
    Dim lngType As Long, strBuffer As String, lngLen As Long
    Dim bytArray() As Byte

    strKey = "SYSTEM\MountedDevices"
    strValue = "\DosDevices\" & pstrDrive
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0&, KEY_QUERY_VALUE, _
    lngHandle) = ERROR_SUCCESS Then
        If RegQueryValueEx(lngHandle, strValue, 0&, lngType, 0&, lngLen) = 234 Then
            If lngType = REG_BINARY Then
                strBuffer = Space$(lngLen)
                If RegQueryValueEx(lngHandle, strValue, 0&, 0&, ByVal _
                strBuffer, lngLen) = ERROR_SUCCESS Then
                    If lngLen > 0 Then
                        ReDim bytArray(lngLen - 1)
                        bytArray = Left$(strBuffer, lngLen)
                        strBuffer = StrConv(bytArray, vbFromUnicode)
                        Erase bytArray
                        If Left$(strBuffer, 4) = "\??\" Then
                            strBuffer = Mid$(strBuffer, 5, InStr(1, _
                            strBuffer, "{") - 6)
                            GetDeviceInstance = Replace(strBuffer, "#", "\")
                        End If
                    End If
                End If
            End If
        End If
        RegCloseKey lngHandle
    End If

برچسب ها: eject ، فلش مموری ، usb ،

برنامه لیگ برتر ایران تحت اكسس

توسط این برنامه می توانید نتایج بازیهای لیگ ایران را وارد و جدول نهایی را مشاهده نمایید.
از امكانات قابل توجه این برنامه می توان به نمایش جدول تا هفته ای خاص، امكان جستجوی نتایج تیم دلخواه و بازیهای آینده تیم دلخواه، امكان جستجوی نتیجه بازی دو تیم دلخواه و ... اشاره نمود.

دوستان توجه نمایند كه برای نمایش بهتر برنامه بهتر است فونت نازنین را كه پیوست نموده ام در سیستم خود نصب كنند.

نكته بسیار مهم: حتما قبل از اجرای برنامه یك فایل اكسس به دلخواه باز كرده و از منوی tools گزینه macro و سپس security را انتخاب كنید و در پنجره باز شده گزینه Low را انتخاب كنید.
دوستانی هم كه از Office 2007 استفاده می كنند به ترتیب زیر عمل كنند:
یك فایل اكسس دلخواه باز نموده و دكمه access option را بفشارید.از قسمت trust sender گزینه trust sender setting را انتخاب كرده و macro setting را برگزیده و حالت enable all macro را انتخاب كنید.

قراردادن این برنامه در سایتهای دیگر با ذكر نام منبع بلامانع است.

پسورد فایل : shahramvb

دانلود برنامه
دانلود فونت نازنین

باز كردن صفحه وب با VB

شما می تونید با اون از طریق Internet Explorer به سایت مورد نظرتون از داخل برنامه خودتون وارد بشید :
این كد را در قسمت Form / General بنویسید

(Private Sub OpenUrl (URLName As String
Dim objIE As Object
Set objIE = CreateObject ("internetexplorer.application ")
objIE.Visible = True
objIE.Navigate (Trim(URLName))
End Sub

بعد یك Command و یك Textbox روی صفحه بذارید و خصوصیت Name اونها رو به ترتیب cmdGOو txtURLName قراربدید ، بعد هم می تونید با نوشتن كد زیر در رویداد Click مربوط به cmdGo به هر صفحه ای كه در ابنترنت دوست دارید دسترسی داشته باشید. به همین سادگی !

( )Private Sub cmdGO_Click
Call OpenUrl (txtURLName)
End Sub

در این كد شما از مدل شی ء Internet Explorer استفاده كردید كه ما از دوصفت اون یعنیVisible برای نمابش IE و Navigate برای فراخوانی URL مورد نظر استفاده كردیم.

برچسب ها: صفحه وب ، باز كردن سایت ،

سلام

این روزا كمتر وقت می كنم وبلاگ رو آپدیت كنم.
دوستان اگر مایلند مطلبی در وبلاگ بذارند تماس بگیرن تا به نام خودشون مطلب قرار داده بشه.

كتاب آموزشی VBA

در بسته مایكروسافت آفیس برای استفاده بهتر از قابلیت های نرم افزار قسمتی برای برنامه نویسی به زبان VB در آن قرار داده شده است كه به این زبان به اختصار VBA گفته می شود.
می توانید كتاب آموزشی آن را دانلود كنید.

دانلود

ارتباط ویژوال بیسیك با اكسل

خودم در ابتدای دوران آموزش كد نویسی ویژوال بیسك از آنجاییكه در اكسل هم از ویژوال بیسیك استفاده می كردم بسیار مایل بودم طریق ارتباط بین ویژوال بیسیك و اكسل را بدانم.اگر شما هم مایلید كه این آموزش را بیاموزید مطلب من را دنبال كنید.
چگونگی ارتباط ویژوال بیسیك و اكسل مایكروسافت:

در ابتدای امر باید از منوی project و سپس references گزینه Microsoft Excel 11.0 Object Library را انتخاب كنید.
سپس باید دو متغیر به شرح ذیل از نوع workbook و worksheet در Form_Load معرفی كنید:

    Dim ss As Excel.Workbook
    Dim dd As Excel.Worksheet

سپس باسد اسن دو متغیر را با یك فایل اكسل set كنید:

Set ss = Workbooks.Open(App.Path & "\log.xls")
   Set dd = ss.Worksheets.Item(1 )

حال می توانید تمامی متد های متداول را در متدهای ss و dd ببینید.
به عنوان مثال می توانید عدد 5 را در خانه A6 به شرح ذیل قرار دهید:

dd.Range("A6" ) =5

در پایان هم می توانید فایلتان را save كنید و ببندید:

ss.Save
    ss.Close True

حال با باز كردن فایل اكسلتان به صورت دستی می توانید تغییرات را مشاهده كنید.

برچسب ها: اكسل ، ارتباط با ویژوال بیسیك ، Excel ،

ساخت توابع در اكسل (قسمت دوم)

در قسمت قبلی با ساخت یك تابع ساده در اكسل آشنا شدید.
تابعی كه تنها می توانست دو سلول را با هم مقایسه كند.حال اگر بخواهیم در تابعی با چندین سلول كار كنیم  و یا به عبارت دیگر با یك آرایه از سلولها مواجه باشیم چه باید كرد؟
فرض كنید می خواهید تعداد حرفهای تكرار شده دلخواه در دسته ای از سلولها را بشمارید.به عنوان مثال می خواهید بدانید  حرف A در سلولهای A1 تا B10 چند بار تكرار شده است.
بنابراین مشاهده می كنید كه دیگر با یك سلول به عنوان آرگومان سر و كار ندارید و باید آرایه ای از سلولها كه شامل 20 خانه از A1 تا B10 است را برای تابع بفرستید.
اولین نكته این است كه آرگومان سلولها باید از نوع Range انتخاب گردد.برنامه من دو آرگومان به تابع با نام های Range كه همان آرایه ای از سلولهاست و Word كه حرف مورد نظر من است می فرستد.كد زیر را در یك ماژول بنویسید و نتیجه را ببینید:

Function Count_Word(range As range, word As String)
  n = range.Count
  For i = 0 To n
  On Error Resume Next
    c1 = range(i) & c1
    Next
    a = c1
    For i = 1 To Len(a)
     If Mid(a, i, 1) = word Then Count_Word = Count_Word + 1
    Next
End Function

ساخت توابع در اكسل (قسمت اول)

شاید بسیاری از شما تا كنون با توابع موجود در اكسل سر و كار داشته اید.توابعی همچون If,Sum,CountIf و بسیاری از توابع دیگر از قبیل توابع ریاضی ، منطقی ، آماری و ....
با خواندن این سلسله از آموزش ساخت توابع در اكسل خواهید آموخت كه چگونه توابعی دلخواه برای خود در محیط اكسل به هر نامی كه دوست دارید بسازید.پس با من همراه شوید:

به این مثال توجه كنید:
فرض كنید می خواهید توسط تابعی به نام COMPARE دو سلول را از نظر عددی با هم مقایسه كنید.به این ترتیب كه اگر سلول اولی بزرگتر بود عدد 1 و اگر كوچكتر بود 1- و اگر مساوی بودند عدد 0 پاسخ تابعتان باشد.
دقت كنید كه برای نوشتن هر تابع شما نیازمند آن هستید كه در محیط ویژوال بیسیك اكسل یك FUNCTION با همان نام ایجاد كنید.بنابراین محیط ویژوال بیسیك را باز كرده (برای این منظور می توانید از منوی Tools گزینه Macro و سپس VisualBasic Editor را انتخاب كرده و یا از دكمه های تركیبی Alt +F11 استفاده كنید) و از منوی Insert گزینه Module را انتخاب كنید.
حال در این محیط می توانید كد مربوط به Function خود را وارد كنید.برای مثال فوق كد زیر را بنویسید:

Function COMPARE(cell1, cell2)
If cell1 > cell2 Then
    COMPARE = 1
ElseIf cell1 < cell2 Then
    COMPARE = -1
Else
    COMPARE = 0
End If
End Function

با اضافه كردن كد فوق در لیست توابع شما همانگونه كه در تصویر می بینید تابع COMPARE اضافه خواهد شد.




با انتخاب این تابع و قرار دادن دو عدد دلخواه در سلول انتخابی نتیجه را خواهید دید.




ادامه دارد...

برچسب ها: اكسل ، VBA ، تابع در اكسل ، Function ،

ارتباط با پورت سریال

شاید این سوال خیلی ها باشه كه بخوان با ویژوال بیسیك به پورت سریال كامپیوتر دسترسی داشته باشن.
اطلاعات ارسال و دریافت كنند.
برای این منظور نیاز به یك كامپوننت داریم به نام microsoft com control 6.0 كه می توانید از منوی project , سپس component به برنامه اضافه كنید.
اما كدهای زیر تنظیمات ابتدایی را برای آماده سازی این كامپوننت نشان میدهد:

ms.CommPort = 1
ms.PortOpen = True

برای ارسال اظلاعات هم می توانید از متد output , برای دریافت اطلاعات از متد input استفاده كنید.

برچسب ها: پورت سریال ،