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
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)
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)