کلندر دریا پلنر ۱۴۰۵ - کد عالی- مارجین دار برای شمسی

Option Explicit


Sub GenerateCalendarRabbit()

    Dim pptPres As Presentation

    Dim slideTemplate5W As Slide, slideTemplate6W As Slide

    Dim currentSlide As Slide

    Dim eventFile As String, monthFile As String

    Dim eventData As Variant, monthData As Variant

    Dim m As Integer, d As Integer

    Dim row As Integer, col As Integer

    Dim solarDay As Integer, lunarDay As Integer, gregDay As Integer

    Dim solarMonth As Integer, lunarMonth As Integer, gregMonth As Integer


    ' Array declarations for month day limits

    Dim shamsiDays(1 To 12) As Integer

    shamsiDays(1) = 31: shamsiDays(2) = 31: shamsiDays(3) = 31

    shamsiDays(4) = 31: shamsiDays(5) = 31: shamsiDays(6) = 31

    shamsiDays(7) = 30: shamsiDays(8) = 30: shamsiDays(9) = 30

    shamsiDays(10) = 30: shamsiDays(11) = 30: shamsiDays(12) = 29


    Dim miladiDays(1 To 12) As Integer

    miladiDays(1) = 31: miladiDays(2) = 28: miladiDays(3) = 31

    miladiDays(4) = 30: miladiDays(5) = 31: miladiDays(6) = 30

    miladiDays(7) = 31: miladiDays(8) = 31: miladiDays(9) = 30

    miladiDays(10) = 31: miladiDays(11) = 30: miladiDays(12) = 31


    Dim ghamariDays(1 To 12) As Integer

    ghamariDays(1) = 30: ghamariDays(2) = 29: ghamariDays(3) = 30

    ghamariDays(4) = 29: ghamariDays(5) = 30: ghamariDays(6) = 30

    ghamariDays(7) = 30: ghamariDays(8) = 29: ghamariDays(9) = 30

    ghamariDays(10) = 29: ghamariDays(11) = 29: ghamariDays(12) = 29


    Set pptPres = ActivePresentation

    eventFile = "/Users/apple/events_output_toolani.txt"

    monthFile = "/Users/apple/monthnames_output.txt" ' ???? ???? ??? ??????


    ' Read event and month data into arrays

    eventData = ReadTextFile(eventFile)

    monthData = ReadTextFile(monthFile)


    Set slideTemplate5W = pptPres.Slides(1)

    Set slideTemplate6W = pptPres.Slides(2)


    ' Initial Date & Position (1 Farvardin 1404 = Friday)

    solarDay = 1: solarMonth = 1

    lunarDay = 1: lunarMonth = 10 ' SHAval 1446

    gregDay = 21: gregMonth = 3   ' March 2025


    col = 1 ' Starts on shanbe


    ' Loop through 12 Shamsi months

    For m = 1 To 12

        Dim monthLen As Integer

        monthLen = shamsiDays(m)


        ' FIX: Pure mathematical check for 5-week or 6-week slide template.

        Dim activeStartCol As Integer

        If col >= 6 Then activeStartCol = col - 1 Else activeStartCol = col


        If (activeStartCol + monthLen - 1) > 35 Then

             Set currentSlide = slideTemplate6W.Duplicate(1)

        Else

             Set currentSlide = slideTemplate5W.Duplicate(1)

        End If


        currentSlide.MoveTo pptPres.Slides.count


        ' CRITICAL FIX: Always enforce row 2 at the exact start of every new slide

        row = 2


        ' --- ??????? ? ????? ??? ?????? ???? ?????? ???? ---

        If m - 1 <= UBound(monthData) Then

            Dim mainParts() As String

            mainParts = Split(monthData(m - 1), "|||")


            ' 1. ??? ??? ???? (??? ??? - ???? 79? ???? 1 ? 1)

            Dim shamsiMonthName As String

            shamsiMonthName = ConvertUnicodeCsvToText(mainParts(0))

            With currentSlide.Shapes("Table 79").Table.Cell(1, 1).Shape.TextFrame.TextRange

                .Text = shamsiMonthName

                .Font.Name = "XB Morvarid"

                .Font.Size = 24

                .Font.Bold = True

            End With


            ' 2. ??? ??????? ?????? (??? ??? ? ??? - ???? 1? ??? 1 ???? 2)

            ' ????? ?? ??? ?????? ?? ???? "March - April"

            Dim miladiMonthName As String

            miladiMonthName = Trim(CleanComma(mainParts(1))) & " - " & Trim(CleanComma(mainParts(2)))

            With currentSlide.Shapes("Table 1").Table.Cell(1, 2).Shape.TextFrame.TextRange

                .Text = miladiMonthName

                '.Font.Name = "Arial"

                .Font.Size = 14

                .Font.Bold = True

            End With


            ' 3. ??? ??????? ???? (??? ????? ? ???? - ???? 1? ??? 1 ???? 1)

            Dim lunarMonthName As String

            Dim lunarPart1 As String, lunarPart2 As String

            lunarPart1 = ConvertUnicodeCsvToText(mainParts(3))


            ' ????? ????? ??? ??? ???? ??? ???? ???? ?? ??? (??????? ?? ??? ?? ??????? ??????)

            If UBound(mainParts) >= 4 Then

                lunarPart2 = ConvertUnicodeCsvToText(mainParts(4))

            Else

                lunarPart2 = ""

            End If


            If Trim(lunarPart2) <> "" Then

                lunarMonthName = lunarPart1 & " -" & lunarPart2

            Else

                lunarMonthName = lunarPart1

            End If


            With currentSlide.Shapes("Table 1").Table.Cell(1, 1).Shape.TextFrame.TextRange

                .Text = lunarMonthName

                .Font.Name = "X Vahid"

                .Font.Size = 14

                .Font.Bold = True

            End With

        End If

        ' ------------------------------------------------


        ' Loop through days of the current month

        For d = 1 To monthLen


            ' --- SEARCH LOGIC FOR EVENTS ---

            Dim eventText As String: eventText = ""

            Dim holidayCode As Integer: holidayCode = 1 ' 1 = Normal day by default

            Dim lengthCode As Integer: lengthCode = 0


            Dim i As Long

            Dim prefix As String

            prefix = solarDay & "," & m & ","


            For i = LBound(eventData) To UBound(eventData)

                If Left(eventData(i), Len(prefix)) = prefix Then

                    Dim parts() As String: parts = Split(eventData(i), ",")

                    Dim uBoundParts As Integer: uBoundParts = UBound(parts)


                    lengthCode = CInt(parts(uBoundParts))

                    holidayCode = CInt(parts(uBoundParts - 1))


                    Dim k As Integer

                    For k = 2 To uBoundParts - 2

                        eventText = eventText & ChrW(CInt(parts(k)))

                    Next k

                    Exit For

                End If

            Next i


            ' --- Fill Table 4 (Shamsi) ---

            With currentSlide.Shapes("Table 4").Table.Cell(row, col).Shape.TextFrame

                ' ????? ????????? ?? ????? ?? TextFrame ?????

                .MarginTop = 2

                .MarginRight = 4


                ' ??? ?? ??? ? ???? ?? TextRange

                With .TextRange

                    .Text = vbNullString ' ????? ??? ?? ???? ???????

                    .InsertAfter ConvertToPersian(solarDay) ' ??? ???? ?? ????? ???????


                    ' ???? ????????? ??? ?? ????? ???????

                    .Font.Name = "XB Morvarid"

                    .Font.Size = 16

                    .ParagraphFormat.Alignment = ppAlignRight


                    ' ????? ??? ????

                    If holidayCode = 0 And col <> 8 Then

                        .Font.Color.RGB = RGB(255, 0, 0)

                    Else

                        ' ???? ??? ??? ??????? (????? ????) ?? ?? ??????? ?? ??? ??? ?????? ????? ??? ???? ???? ?????

                        .Font.Color.RGB = RGB(0, 0, 0)

                    End If

                End With

            End With


            ' --- Fill Table 5 (Gregorian & Lunar) ---

            With currentSlide.Shapes("Table 5").Table.Cell(row - 1, col).Shape.TextFrame.TextRange

                .Font.Name = "X Vahid"

                .Font.Size = 16

                .Font.Color.RGB = RGB(1, 187, 130)

                .ParagraphFormat.Alignment = ppAlignLeft

                .Text = vbNullString

                .InsertAfter gregDay & " | " & ConvertToPersian(lunarDay)

            End With


            ' --- Fill Table 2 (Events) ---

            With currentSlide.Shapes("Table 2").Table.Cell(row - 1, col).Shape.TextFrame.TextRange

              .Font.Name = "X Yekan"


              If lengthCode = 5 Then .Font.Size = 8 Else .Font.Size = 9


              If holidayCode = 0 Then

                  .Font.Color.RGB = RGB(255, 0, 0)

              End If


               If eventText <> "" Then

                    .Text = vbNullString

                    .InsertAfter eventText

                End If

            End With


            ' --- Move Rabbit to next cell ---

            If col = 8 Then

                col = 1

                row = row + 1

            Else

                col = col + 1

                If col = 5 Then col = 6 ' Skip empty column

            End If


            ' Advance calendar counters

            solarDay = solarDay + 1

            lunarDay = lunarDay + 1

            gregDay = gregDay + 1


            ' Check Gregorian limits

            If gregDay > miladiDays(gregMonth) Then

                gregDay = 1

                gregMonth = gregMonth + 1

                If gregMonth > 12 Then gregMonth = 1

            End If


            ' Check Lunar limits

            If lunarDay > ghamariDays(lunarMonth) Then

                lunarDay = 1

                lunarMonth = lunarMonth + 1

                If lunarMonth > 12 Then lunarMonth = 1

            End If


        Next d


        ' Advance Shamsi Month

        solarDay = 1

        solarMonth = solarMonth + 1

    Next m


    MsgBox "Done!", vbInformation

End Sub


' ???? ???? ???? ???? ????? ????? ?????? ????-?????? ?? ??? ?????

Function ConvertUnicodeCsvToText(csvStr As String) As String

    Dim cleanStr As String

    cleanStr = Trim(csvStr)

    If cleanStr = "" Then

        ConvertUnicodeCsvToText = ""

        Exit Function

    End If


    Dim codes() As String

    codes = Split(cleanStr, ",")


    Dim res As String: res = ""

    Dim i As Integer

    For i = LBound(codes) To UBound(codes)

        If Trim(codes(i)) <> "" Then

            res = res & ChrW(CInt(Trim(codes(i))))

        End If

    Next i

    ConvertUnicodeCsvToText = res

End Function


Function ReadTextFile(filePath As String) As Variant

    Dim fileNo As Integer

    Dim lineData As String

    Dim allLines() As String

    Dim count As Long


    fileNo = FreeFile

    count = 0


    Open filePath For Input As #fileNo

    Do While Not EOF(fileNo)

        Line Input #fileNo, lineData

        lineData = Trim(lineData)

        If lineData <> "" Then

            ReDim Preserve allLines(count)

            allLines(count) = lineData

            count = count + 1

        End If

    Loop

    Close #fileNo

    ReadTextFile = allLines

End Function


Function ConvertToPersian(m As Integer) As String

    Dim res As String

    Dim digit As Integer

    Dim n As Integer

    n = m

    res = ""

    If n = 0 Then

        ConvertToPersian = ChrW(1776)

        Exit Function

    End If

    While n > 0

        digit = n Mod 10

        res = ChrW(1776 + digit) & res

        n = n \ 10

    Wend

    ConvertToPersian = res

End Function


Function CleanComma(txt As String) As String

    CleanComma = Mid(Trim(txt), 2, Len(txt) - 2)

End Function


خوب ۲-هنوز کمی کج و کوله

Option Explicit


Sub GenerateCalendarRabbit()

    Dim pptPres As Presentation

    Dim slideTemplate5W As Slide, slideTemplate6W As Slide

    Dim currentSlide As Slide

    Dim eventFile As String

    Dim eventData As Variant

    Dim m As Integer, d As Integer

    Dim row As Integer, col As Integer

    Dim solarDay As Integer, lunarDay As Integer, gregDay As Integer

    Dim solarMonth As Integer, lunarMonth As Integer, gregMonth As Integer

    

    ' Array declarations for month day limits

    Dim shamsiDays(1 To 12) As Integer

    shamsiDays(1) = 31: shamsiDays(2) = 31: shamsiDays(3) = 31

    shamsiDays(4) = 31: shamsiDays(5) = 31: shamsiDays(6) = 31

    shamsiDays(7) = 30: shamsiDays(8) = 30: shamsiDays(9) = 30

    shamsiDays(10) = 30: shamsiDays(11) = 30: shamsiDays(12) = 29

    

    Dim miladiDays(1 To 12) As Integer

    miladiDays(1) = 31: miladiDays(2) = 28: miladiDays(3) = 31

    miladiDays(4) = 30: miladiDays(5) = 31: miladiDays(6) = 30

    miladiDays(7) = 31: miladiDays(8) = 31: miladiDays(9) = 30

    miladiDays(10) = 31: miladiDays(11) = 30: miladiDays(12) = 31


    Dim ghamariDays(1 To 12) As Integer

    ghamariDays(1) = 29: ghamariDays(2) = 29: ghamariDays(3) = 29

    ghamariDays(4) = 30: ghamariDays(5) = 29: ghamariDays(6) = 30

    ghamariDays(7) = 30: ghamariDays(8) = 29: ghamariDays(9) = 30

    ghamariDays(10) = 30: ghamariDays(11) = 30: ghamariDays(12) = 29

    

    Set pptPres = ActivePresentation

    eventFile = "/Users/apple/events_output_toolani.txt"

    

    ' Read event data into an array

    eventData = ReadTextFile(eventFile)

    

    Set slideTemplate5W = pptPres.Slides(1)

    Set slideTemplate6W = pptPres.Slides(2)

    

    ' Initial Date & Position (1 Farvardin 1404 = Friday)

    solarDay = 1: solarMonth = 1

    lunarDay = 20: lunarMonth = 1 ' Ramadan 1446

    gregDay = 21: gregMonth = 3   ' March 2025

    

    col = 8 ' Starts on Friday

    

    ' Loop through 12 Shamsi months

    For m = 1 To 12

        Dim monthLen As Integer

        monthLen = shamsiDays(m)

        

        ' FIX: Pure mathematical check for 5-week or 6-week slide template.

        ' Column 5 is skipped, so we adjust the calculation to mimic 7 active columns.

        Dim activeStartCol As Integer

        If col >= 6 Then activeStartCol = col - 1 Else activeStartCol = col

        

        If (activeStartCol + monthLen - 1) > 35 Then

             Set currentSlide = slideTemplate6W.Duplicate(1)

        Else

             Set currentSlide = slideTemplate5W.Duplicate(1)

        End If

        

        ' CRITICAL FIX: Always enforce row 2 at the exact start of every new slide

        row = 2

        

        ' Loop through days of the current month

        For d = 1 To monthLen

            

            ' --- SEARCH LOGIC FOR EVENTS ---

            Dim eventText As String: eventText = ""

            Dim holidayCode As Integer: holidayCode = 1 ' 1 = Normal day by default

            Dim lengthCode As Integer: lengthCode = 0

            

            Dim i As Long

            Dim prefix As String

            prefix = solarDay & "," & m & ","

            

            For i = LBound(eventData) To UBound(eventData)

                If Left(eventData(i), Len(prefix)) = prefix Then

                    Dim parts() As String: parts = Split(eventData(i), ",")

                    Dim uBoundParts As Integer: uBoundParts = UBound(parts)

                    

                    lengthCode = CInt(parts(uBoundParts))

                    holidayCode = CInt(parts(uBoundParts - 1))

                    

                    Dim k As Integer

                    For k = 2 To uBoundParts - 2

                        eventText = eventText & ChrW(CInt(parts(k)))

                    Next k

                    Exit For

                End If

            Next i

            

            ' --- Fill Table 4 (Shamsi) ---

            With currentSlide.Shapes("Table 4").Table.Cell(row, col).Shape.TextFrame.TextRange

                .Text = ConvertToPersian(solarDay)

                .Font.Name = "XB Morvarid"

                .Font.Size = 16

                If holidayCode = 0 And col <> 8 Then

                    .Font.Color.RGB = RGB(255, 0, 0)

                Else

                    .Font.Color.RGB = RGB(0, 0, 0)

                End If

            End With

            

            ' --- Fill Table 5 (Gregorian & Lunar) ---

            With currentSlide.Shapes("Table 5").Table.Cell(row - 1, col).Shape.TextFrame.TextRange

                .Text = gregDay & " | " & ConvertToPersian(lunarDay)

                .Font.Name = "X Vahid"

                .Font.Size = 16

                .Font.Color.RGB = RGB(1, 187, 130)

            End With

            

            ' --- Fill Table 2 (Events) ---

            With currentSlide.Shapes("Table 2").Table.Cell(row - 1, col).Shape.TextFrame.TextRange

                .Text = eventText

                .Font.Name = "X Yekan"

                

                If lengthCode = 5 Then .Font.Size = 8 Else .Font.Size = 9

                

                If holidayCode = 0 Then

                    .Font.Color.RGB = RGB(255, 0, 0)

                Else

                    .Font.Color.RGB = RGB(0, 0, 0)

                End If

            End With

            

            ' --- Move Rabbit to next cell ---

            If col = 8 Then

                col = 1

                row = row + 1

            Else

                col = col + 1

                If col = 5 Then col = 6 ' Skip empty column

            End If

            

            ' Advance calendar counters

            solarDay = solarDay + 1

            lunarDay = lunarDay + 1

            gregDay = gregDay + 1

            

            ' Check Gregorian limits

            If gregDay > miladiDays(gregMonth) Then

                gregDay = 1

                gregMonth = gregMonth + 1

                If gregMonth > 12 Then gregMonth = 1

            End If

            

            ' Check Lunar limits

            If lunarDay > ghamariDays(lunarMonth) Then

                lunarDay = 1

                lunarMonth = lunarMonth + 1

                If lunarMonth > 12 Then lunarMonth = 1

            End If

            

        Next d

        

        ' Advance Shamsi Month

        solarDay = 1

        solarMonth = solarMonth + 1

    Next m

    

    MsgBox "Done!", vbInformation

End Sub


Function ReadTextFile(filePath As String) As Variant

    Dim fileNo As Integer

    Dim lineData As String

    Dim allLines() As String

    Dim count As Long

    

    fileNo = FreeFile

    count = 0

    

    Open filePath For Input As #fileNo

    Do While Not EOF(fileNo)

        Line Input #fileNo, lineData

        lineData = Trim(lineData)

        If lineData <> "" Then

            ReDim Preserve allLines(count)

            allLines(count) = lineData

            count = count + 1

        End If

    Loop

    Close #fileNo

    ReadTextFile = allLines

End Function


Function ConvertToPersian(m As Integer) As String

    Dim res As String

    Dim digit As Integer

    Dim n As Integer

    n = m

    res = ""

    If n = 0 Then

        ConvertToPersian = ChrW(1776)

        Exit Function

    End If

    While n > 0

        digit = n Mod 10

        res = ChrW(1776 + digit) & res

        n = n \ 10

    Wend

    ConvertToPersian = res

End Function


کد vba که میتونه مناسبت ها را اگر چه غلط و غولوط پیدا کنه

Sub GenerateCalendarMacCompatible()

    Dim pptPres As Presentation

    Set pptPres = ActivePresentation

    

    Dim folderPath As String

    folderPath = "/Users/apple/"

    

    Dim eventsFile As String, monthsFile As String

    eventsFile = folderPath & "events_output_toolani.txt"

    monthsFile = folderPath & "monthnames_output.txt"

    

    Dim eventRows() As String, monthRows() As String

    eventRows = ReadFileBinaryMac(eventsFile)

    monthRows = ReadFileBinaryMac(monthsFile)

    

    Dim m As Integer

    For m = 1 To 12

        Dim dayOffset As Integer

        dayOffset = GetMonthStartOffset(m)

        

        Dim totalDays As Integer

        If m <= 6 Then totalDays = 31 Else totalDays = 30

        

        Dim totalCellsNeeded As Integer

        Dim testOffset As Integer

        testOffset = dayOffset

        If dayOffset >= 4 Then testOffset = dayOffset + 1

        totalCellsNeeded = testOffset + totalDays

        

        Dim slideMasterIndex As Integer

        If totalCellsNeeded > 36 Then

            slideMasterIndex = 3

        Else

            slideMasterIndex = 1

        End If

        

        Dim newSlide As Slide

        Set newSlide = pptPres.Slides(slideMasterIndex).Duplicate()(1)

        newSlide.MoveTo pptPres.Slides.Count

        

        If m - 1 <= UBound(monthRows) Then

            Dim currentMonthInfo As String

            currentMonthInfo = monthRows(m - 1)

            

            If Trim(currentMonthInfo) <> "" Then

                Dim monthParts() As String

                monthParts = Split(currentMonthInfo, "|||")

                

                Dim shp As Shape

                For Each shp In newSlide.Shapes

                    If shp.HasTextFrame And (shp.Name Like "*Persian*" Or shp.Name Like "*Month*") Then

                        shp.TextFrame.TextRange.Text = DecodeUnicodeString(monthParts(0))

                    End If

                    

                    If shp.HasTextFrame And (shp.Name Like "*Hijri*" Or shp.Rotation <> 0) Then

                        Dim hijriText As String

                        hijriText = ""

                        If UBound(monthParts) >= 3 Then

                            hijriText = DecodeUnicodeString(monthParts(3))

                            If UBound(monthParts) >= 4 Then

                                If Trim(monthParts(4)) <> "" And Val(monthParts(4)) > 0 Then

                                    hijriText = hijriText & " - " & DecodeUnicodeString(monthParts(4))

                                End If

                            End If

                        End If

                        shp.TextFrame.TextRange.Text = Trim(hijriText)

                    End If

                    

                    If shp.HasTextFrame And (shp.Name Like "*Gregorian*" Or shp.Name Like "*English*") Then

                        Dim conversionText As String

                        conversionText = ""

                        If UBound(monthParts) >= 2 Then

                            conversionText = Trim(monthParts(1)) & " - " & Trim(monthParts(2))

                        End If

                        shp.TextFrame.TextRange.Text = conversionText

                    End If

                Next shp

            End If

        End If

        

        Dim tbl As Table

        For Each shp In newSlide.Shapes

            If shp.HasTable Then Set tbl = shp.Table: Exit For

        Next shp

        

        If Not tbl Is Nothing Then

            Dim d As Integer

            For d = 1 To totalDays

                Dim cellNum As Integer

                cellNum = dayOffset + d - 1

                

                Dim rawCol As Integer

                rawCol = (cellNum Mod 7) + 1

                

                Dim c As Integer

                If rawCol <= 4 Then

                    c = rawCol

                Else

                    c = rawCol + 1

                End If

                

                Dim r As Integer

                r = (cellNum \ 7) + 2

                

                Do While r > tbl.Rows.Count

                    tbl.Rows.Add

                Loop

                

                Dim mainRange As TextRange

                Set mainRange = tbl.Cell(r, c).Shape.TextFrame.TextRange

                

                Dim gregDay As Integer, hijriDay As Integer

                gregDay = ((d + 20) Mod 30) + 1

                hijriDay = ((d + 5) Mod 29) + 1

                

                mainRange.Text = CStr(d) & "  " & CStr(gregDay) & "|" & CStr(hijriDay)

                mainRange.Font.Name = "X Vahid"

                mainRange.Font.Size = 16

                mainRange.Font.Color.RGB = RGB(1, 187, 130)

                

                Dim eventDesc As String

                Dim isHoliday As Boolean

                Dim isLongText As Boolean

                Dim hasEvent As Boolean

                

                CheckEventDetails m, d, eventRows, eventDesc, isHoliday, isLongText, hasEvent

                

                If hasEvent Then

                    Dim startPos As Integer

                    startPos = Len(mainRange.Text) + 2

                    

                    mainRange.Text = mainRange.Text & vbCrLf & eventDesc

                    

                    Dim eventRange As TextRange

                    Set eventRange = mainRange.Characters(startPos, Len(eventDesc))

                    eventRange.Font.Name = "X Yekan"

                    

                    If isLongText Then

                        eventRange.Font.Size = 8

                    Else

                        eventRange.Font.Size = 9

                    End If

                    

                    If isHoliday Then

                        eventRange.Font.Color.RGB = RGB(255, 0, 0)

                        If c <> 8 Then

                            mainRange.Characters(1, startPos - 2).Font.Color.RGB = RGB(255, 0, 0)

                        End If

                    Else

                        eventRange.Font.Color.RGB = RGB(31, 78, 121)

                    End If

                End If

            Next d

        End If

    Next m

    

    MsgBox "Calendar generated successfully with correct styles!", vbInformation, "Done"

End Sub


Function ReadFileBinaryMac(filePath As String) As String()

    Dim fileNo As Integer

    Dim fileBytes() As Byte

    Dim fileContent As String

    Dim lines() As String

    

    fileNo = FreeFile

    Open filePath For Binary Access Read As #fileNo

    ReDim fileBytes(LOF(fileNo) - 1)

    Get #fileNo, , fileBytes

    Close #fileNo

    

    fileContent = StrConv(fileBytes, vbUnicode)

    fileContent = Replace(fileContent, vbCrLf, vbLf)

    fileContent = Replace(fileContent, vbCr, vbLf)

    lines = Split(fileContent, vbLf)

    

    ReadFileBinaryMac = lines

End Function


Sub CheckEventDetails(monthIdx As Integer, dayIdx As Integer, ByRef rows() As String, ByRef outDesc As String, ByRef outIsHoliday As Boolean, ByRef outIsLong As Boolean, ByRef outHasEvent As Boolean)

    outHasEvent = False

    outDesc = ""

    outIsHoliday = False

    outIsLong = False

    

    Dim i As Long

    For i = 0 To UBound(rows)

        If Trim(rows(i)) <> "" Then

            Dim parts() As String

            parts = Split(rows(i), ",")

            

            If UBound(parts) >= 2 Then

                If Val(parts(0)) = dayIdx And Val(parts(1)) = monthIdx Then

                    outHasEvent = True

                    

                    Dim cleanText As String

                    cleanText = ""

                    Dim j As Integer

                    For j = 2 To UBound(parts) - 2

                        If Val(parts(j)) > 0 Then

                            cleanText = cleanText & ChrW(Val(parts(j)))

                        End If

                    Next j

                    outDesc = cleanText

                    

                    If Val(parts(UBound(parts) - 1)) = 0 Then outIsHoliday = True

                    If Val(parts(UBound(parts))) = 5 Then outIsLong = True

                    Exit Sub

                End If

            End If

        End If

    Next i

End Sub


Function DecodeUnicodeString(commaSeparatedCodes As String) As String

    Dim parts() As String

    parts = Split(commaSeparatedCodes, ",")

    Dim res As String, i As Integer

    For i = 0 To UBound(parts)

        If Val(parts(i)) > 0 Then res = res & ChrW(Val(parts(i)))

    Next i

    DecodeUnicodeString = res

End Function


Function GetMonthStartOffset(monthNum As Integer) As Integer

    Select Case monthNum

        Case 1: GetMonthStartOffset = 0

        Case 2: GetMonthStartOffset = 3

        Case 3: GetMonthStartOffset = 5

        Case 4: GetMonthStartOffset = 1

        Case 5: GetMonthStartOffset = 4

        Case 6: GetMonthStartOffset = 6

        Case 7: GetMonthStartOffset = 1

        Case 8: GetMonthStartOffset = 3

        Case 9: GetMonthStartOffset = 5

        Case 10: GetMonthStartOffset = 0

        Case 11: GetMonthStartOffset = 2

        Case 12: GetMonthStartOffset = 4

        Case Else: GetMonthStartOffset = 0

    End Select

End Function

monthsnames

from openpyxl import load_workbook


INPUT_FILE = "/Users/apple/Downloads/دانلودها/پارسال-فیک- دریا پلنر copy/monthnames.xlsx"





import pandas as pd

import os



def to_unicode(value):

    if pd.isna(value):

        return ""

    value = str(value)          # هیچ strip نکن

    return ",".join(str(ord(c)) for c in value)



excel_path = INPUT_FILE


df = pd.read_excel(excel_path, header=0, dtype=str)


output_path = os.path.splitext(excel_path)[0] + "_output432.txt"


with open(output_path, "w", encoding="utf-8", newline="") as f:


    for _, row in df.iterrows():


        p = to_unicode(row.iloc[0])


        en1 = "" if pd.isna(row.iloc[1]) else str(row.iloc[1])


        en2 = "" if pd.isna(row.iloc[2]) else str(row.iloc[2])


        a1 = to_unicode(row.iloc[3])


        a2 = to_unicode(row.iloc[4])


        line = (

            f"{p},|||,"

            f"{en1},|||,"

            f"{en2},|||,"

            f"{a2},|||,"

            f"{a1},|||"


        )


        f.write(line + "\n")


print("Done.")

print(output_path)


nameofweekdays.xlsx → nameofweekdays.txt تست شده

import pandas as pd

import os



def text_to_unicode(text):

    if pd.isna(text):

        return ""

    return ",".join(str(ord(ch)) for ch in str(text))



excel_path = "/Users/apple/Downloads/دانلودها/پارسال-فیک- دریا پلنر copy/nameofweekdays.xlsx" #"/Users/apple/Downloads/دانلودها/پارسال-فیک- دریا پلنر copy/monthnames.xlsx"


 #input("Excel file path: ").strip()


df = pd.read_excel(excel_path)


output_path = os.path.splitext(excel_path)[0] + "313.txt"


with open(output_path, "w", encoding="utf-8") as f:


    for _, row in df.iterrows():


        text = text_to_unicode(row.iloc[0])


        f.write(text + "\n")


print("Done.")

print(output_path)