+ Reply to Thread
Results 1 to 6 of 6

if cell value is hijri or gregorian date?

Hybrid View

  1. #1
    Registered User
    Join Date
    10-05-2011
    Location
    Philippines
    MS-Off Ver
    Excel 2007
    Posts
    42

    Smile Re: if cell value is hijri or gregorian date?

    thank you TMS! Attached is the sample workbook!

    Maybe this solution will work?
    if Year(date1) <=1900 then
       'its a hijri date
    else
       'its a gregorian date
    end if
    Please correct if my idea is wrong!

    Thank you!
    Attached Files Attached Files

  2. #2
    Forum Guru TMS's Avatar
    Join Date
    07-15-2010
    Location
    The Great City of Manchester, NW England ;-)
    MS-Off Ver
    MSO 2007,2010,365
    Posts
    48,359

    Re: if cell value is hijri or gregorian date?

    I found the following code in an Access Forum and it works, unchanged, in Excel 2007.

    ' http://www.access-programmers.co.uk/forums/showthread.php?t=246559
    ' hafeezksa
    
    ' Hijri (Arabic) date to Gregorian date converter module ...
    
    '------------------------------------------
    Option Compare Binary
    Option Explicit
    ' Constants from olenls.h
    Private Const LOCALE_ICALENDARTYPE = &H1009 ' /* type of calendar specifier */
    Private Const CAL_HIJRI = 6 ' /* Hijri (Arabic Lunar) calendar */
    Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal lcid As Long, ByVal LCTYPE As Long, lpData As Any, ByVal cchData As Integer) As Integer
    Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
    Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
    Private m_iHijri As Integer
    '------------------------------------------------------------
    ' StDteGregOfStDteHijri
    '------------------------------------------------------------
    Public Function StDteGregOfStDteHijri(ByVal stDateHijri As String) As String
    On Error Resume Next
    Dim dte As Date
    
    If Len(stDateHijri) > 0 Then
    VBA.Calendar = vbCalHijri
    dte = CDate(stDateHijri)
    VBA.Calendar = vbCalGreg
    StDteGregOfStDteHijri = CStr(dte)
    End If
    
    If Err.Number <> 0 Then StDteGregOfStDteHijri = stDateHijri
    End Function
    '------------------------------------------------------------
    ' StDteHijriOfStDteGreg
    '------------------------------------------------------------
    Public Function StDteHijriOfStDteGreg(ByVal stDateGreg As String) As String
    On Error Resume Next
    Dim dte As Date
    
    If Len(stDateGreg) > 0 Then
    dte = CDate(stDateGreg)
    VBA.Calendar = vbCalHijri
    StDteHijriOfStDteGreg = CStr(dte)
    VBA.Calendar = vbCalGreg
    End If
    
    If Err.Number <> 0 Then StDteHijriOfStDteGreg = stDateGreg
    End Function
    '-----------------------------------------------------
    ' FHijriCalendar
    '-----------------------------------------------------
    Public Property Get FHijriCalendar() As Boolean
    Dim stCal As String
    
    If m_iHijri = 0 Then
    stCal = StGetLocaleInfo(LOCALE_ICALENDARTYPE, False)
    If (Val(stCal) = CAL_HIJRI) Then
    m_iHijri = 1
    Else
    m_iHijri = 2
    End If
    End If
    
    FHijriCalendar = (m_iHijri = 1)
    End Property
    '----------------------------------------------------------------------
    ' StGetLocaleInfo
    '
    ' Gets Locale (international) info about current config
    ' See LOCALE constants at top of module for LCTYPE values
    '----------------------------------------------------------------------
    Public Function StGetLocaleInfo(LCTYPE As Long, Optional fUserDefault As Boolean = True) As String
    Dim lcid As Long
    Dim stBuff As String * 255
    
    'Get current language ID
    If fUserDefault Then
    lcid = GetUserDefaultLCID()
    Else
    lcid = GetSystemDefaultLCID()
    End If
    
    'ask for the locale info
    If (GetLocaleInfo(lcid, LCTYPE, ByVal stBuff, Len(stBuff)) > 0) Then
    StGetLocaleInfo = StFromSz(stBuff)
    End If
    End Function
    '------------------------------------------------------------
    ' StFromSz
    '
    ' Find the first vbNullChar in a string, and return
    ' everything prior to that character. Extremely
    ' useful when combined with the Windows API function calls.
    '------------------------------------------------------------
    Public Function StFromSz(ByVal sz As String) As String
    
    Dim ich As Integer
    
    ich = InStr(sz, vbNullChar)
    Select Case ich
    ' It's best to put the most likely case first.
    Case Is > 1
    ' Found in the string, so return the portion
    ' up to the null character.
    StFromSz = Left$(sz, ich - 1)
    Case 0
    ' Not found at all, so just
    ' return the original value.
    StFromSz = sz
    Case 1
    ' Found at the first position, so return an empty string.
    StFromSz = vbNullString
    End Select
    End Function

    Assuming that the calculation is accurate (which I can't really check), this should meet your needs.

    See the attached updated sample workbook.

    Regards, TMS
    Trevor Shuttleworth - Retired Excel/VBA Consultant

    I dream of a better world where chickens can cross the road without having their motives questioned

    'Being unapologetic means never having to say you're sorry' John Cooper Clarke


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. identify if a date in a cell is hijri or gregorian..?
    By adbasanta in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 01-06-2015, 06:41 AM
  2. identify if a date in a cell is hijri or gregorian..?
    By adbasanta in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 01-06-2015, 06:13 AM
  3. convert from Hijri Date to Gregorian
    By noexcel=badwork in forum Excel General
    Replies: 7
    Last Post: 11-04-2014, 03:21 AM
  4. Converting Hijri Date to Gregorian Date from another cell
    By brmuse1 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 04-20-2014, 12:46 AM
  5. [SOLVED] Gregorian Date from Hijri
    By Abdul in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 08-16-2006, 12:25 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1