ahmedkamalali

Create a 12 Month Calendar With The Current Day


Highlighted in Excel

لانشاء نتيجه السنه مع تظليل تاريخ اليوم باستخدام الميكرو فى الاكسل :

1 نقوم بفتح ملف اكسيل جديد
2 نقوم بالضغط على alte+f11
3 سوف تفتح نافذه الفيجوال بيسك
4 نقوم بالضغط على Sheet1 فى الجهه اليسرى من نافذم الفيجوال بيسك
5 نقوم بنسخ الكود التالى وبعد ذلك نقوم بلصقه فى النافذه المفتوحه امام ال Sheet1

Sub CreateCalendar()

Dim lMonth As Long

Dim strMonth As String

Dim rStart As Range

Dim strAddress As String

Dim rCell As Range

Dim lDays As Long

Dim dDate As Date

'Add new sheet and format

Worksheets.Add

ActiveWindow.DisplayGridlines = False

With Cells

.ColumnWidth = 6#

.Font.Size = 8

End With



'Create the Month headings

For lMonth = 1 To 4

Select Case lMonth

Case 1

strMonth = "January"

Set rStart = Range("A1")

Case 2

strMonth = "April"

Set rStart = Range("A8")

Case 3

strMonth = "July"

Set rStart = Range("A15")

Case 4

strMonth = "October"

Set rStart = Range("A22")

End Select

'Merge, AutoFill and align months

With rStart

.Value = strMonth

.HorizontalAlignment = xlCenter

.Interior.ColorIndex = 6

.Font.Bold = True

With .Range("A1:G1")

.Merge

.BorderAround LineStyle:=xlContinuous

End With

.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")

End With

Next lMonth

'Pass ranges for months

For lMonth = 1 To 12

strAddress = Choose(lMonth, "A2:G7", "H2:N7", "O2:U7", _
"A9:G14", "H9:N14", "O9:U14", _
"A16:G21", "H16:N21", "O16:U21", _
"A23:G28", "H23:N28", "O23:U28")

lDays = 0

Range(strAddress).BorderAround LineStyle:=xlContinuous

'Add dates to month range and format

For Each rCell In Range(strAddress)

lDays = lDays + 1

dDate = DateSerial(Year(Date), lMonth, lDays)

If Month(dDate) = lMonth Then ' It's a valid date

With rCell

.Value = dDate

.NumberFormat = "ddd dd"

End With

End If

Next rCell

Next lMonth

'add con formatting

With Range("A1:U28")

.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()"

.FormatConditions(1).Font.ColorIndex = 2

.FormatConditions(1).Interior.ColorIndex = 1

End With

End Sub


6 ستم انشاء Sheet جديد يحتوى على نتيجه السنه



وكل سنه وانتم طيبن

__________________

باسم عاطف

شكر جزيل استاذ احمد على هذة المشاركة الرائعة نتمنى المزيد من هذة المشاركات

فوكس

الطريقه مع اى اوفيس 2003 او 2007 ولا اوفيس معين؟؟؟

__________________
سبحانك اللهم وبحمدك أشهد ان لا اله إلا أنت أستغفرك وأتوب اليك

ahmedkamalali

يستخدم مع office 2003 / 2007

__________________

فوكس

عند الضغط على sheet 1 بيرجعك للاكسل تانى
فانسخ الداتا داخل خلية اكسل فى الشيت ولا فين ؟؟؟

__________________
سبحانك اللهم وبحمدك أشهد ان لا اله إلا أنت أستغفرك وأتوب اليك

ahmedkamalali

عزيزى :

1 - بعد فتح ملف الاكسل سوف تقوم بالضغط على ALT+F11

2 - ستم فتح شاشه ( نافذه جديده وهى الفيجوال بيسك ) مقسمه الى قسمين بالطول

فى القسم اللى على اليسار ستجد sheet 1 / Sheet2 / Sheet3 بعدد الشيت فى الملف المفتوح بالنقر على Sheet1 مرتين سيتم فتح صفحه بيضاء على اليمن يتم نسخ الكود فيها وبعد ذللك تقوم بإغلاق الفيجول بيسك ثم تقوم بالضغط بعد ذلك على alt+8 ثم run للميكرو ستجد النيجه ظهرت فى Sheet1

مرفق ملف للمشاهده

__________________

ahmedkamalali

الملف مرفق

الملفات المرفقة

النتيجه .rar‏ (18.1 كيلوبايت, المشاهدات 153)

__________________

فوكس

يبدو ان العيب في اليوزر , مش عايزه تيجى معايا سكة
عموما شكرا

__________________
سبحانك اللهم وبحمدك أشهد ان لا اله إلا أنت أستغفرك وأتوب اليك

mesalamy

سبحانك اللهم وبحمدك ، أشهد أن لا إله إلا أنت أستغفرك وأتوب إليك

mesalamy

مشكوووووووووووووور