بحث ورود داده در اکسل از طریق لیست کشویی یکی از موارد قدیمی و بسیار پرکاربرد در اکسل بوده و هست. برای ایجاد یک لیست کشویی ساده در اکسل حتما مقاله مربوط به این موضوع رو مطالعه کنید. اما ۲ تا موضوع همیشه مطرح بوده، یکی اینکه بتونیم داخل این لیست، جستجو انجام بدیم (برای مواردی که تعداد آیتم ها زیاد هستن و حرکت بین اونها و پیدا کردن داده مورد نظر سخت باشه). این مسئله در اکسل ۳۶۵ حل شده و لیست های ایجاد شده قابل جستجو هستن. اما اگر مثل من از نسخه غیررایگان اکسل ۳۶۵ استفاده نمیکنید?، این مقاله رو بخونید ببینید چطور باید این کار و بکنید. ویژگی این روش اینه که در هر ورژنی (حتی ۲۰۰۳!) قابل استفاده است. موضوع دومی که مطرح میشه اینه که چطور میشه بیش از یک آیتم در این لیست ها انتخاب کرد. این موضوع هنوز راه حل مستقیمی نداره و ما میخوایم برای حل این موضوع از کد VBA استفاده کنیم. پس تا الان ۲تا از ویژگی های خیلی مهم لیست های کشویی رو تونستیم اضافه کنیم:

ایجاد لیست قابل جستجو
انتخاب بیش از یک مورد

در این مقاله میخواهیم راجع به دومین موضوع صحبت کنیم. یعنی انتخاب بیش از یک مورد در هر سلول.

شکل ۱- انتخاب داده های مورد نظر و ایجاد لیست کشویی

مثلا فرض کنید در یک آرشیو دیجیتال فیلم که طبیعتا یکی از فیلدهای اون ژانر هست، ژانرهای مختلف یک فیلم مثلا، درام، کمدی ،تخیلی و … رو در یک سلول مشخص کنیم.برای این کار اول لیست مورد نظر رو ایجاد میکنیم. برای این کار کافیه ژانرهای مختلف رو در یک ستون وارد کنیم و بعد از مسیر Data/ Data Validation/ List داده های مورد نظر رو انتخاب کنیم و لیست رو بسازیم. (شکل ۱). برای ایجاد لیست داینامیک حتما مقاله مربوط به ایجاد لیست کشویی داینامیک مطالعه کنید.

حالا که لیست رو ساختیم، کافیه کد ماکرو زیر رو وارد فایلمون بکنیم. (در مورد نحوه وارد کردن ماکرو به فایل اکسل و دیدن ماکروهای آماده دیگه، حتما مقاله ماکروهای آماده رو مطالعه کنید)

1- ماکروی ورود دیتای چندتایی با تکرار (امکان ورود یک آیتم بصورت تکراری وجود دارد)

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim DelimiterType As String
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
DelimiterType = ", "
If Destination.Count &gt; 1 Then Exit Sub
 
On Error Resume Next
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError
 
If rngDropdown Is Nothing Then GoTo exitError
 
If Intersect(Destination, rngDropdown) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newValue = Destination.Value
  Application.Undo
  oldValue = Destination.Value
  Destination.Value = newValue
    If oldValue = "" Then
      'do nothing
    Else
      If newValue = "" Then
        'do nothing
      Else
        Destination.Value = oldValue &amp; DelimiterType &amp; newValue
        ' add new value with delimiter
      End If
    End If
End If
 
exitError:
  Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

۱۰

۱۱

۱۲

۱۳

۱۴

۱۵

۱۶

۱۷

۱۸

۱۹

۲۰

۲۱

۲۲

۲۳

۲۴

۲۵

۲۶

۲۷

۲۸

۲۹

۳۰

۳۱

۳۲

۳۳

۳۴

۳۵

۳۶

۳۷

۳۸

۳۹

۴۰

۴۱

۴۲

Option Explicit

Private Sub Worksheet_Change(ByVal Destination As Range)

Dim DelimiterType As String

Dim rngDropdown As Range

Dim oldValue As String

Dim newValue As String

DelimiterType = ", "

If Destination.Count > ۱ Then Exit Sub

On Error Resume Next

Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)

On Error GoTo exitError

If rngDropdown Is Nothing Then GoTo exitError

If Intersect(Destination, rngDropdown) Is Nothing Then

'do nothing

Else

Application.EnableEvents = False

newValue = Destination.Value

Application.Undo

oldValue = Destination.Value

Destination.Value = newValue

If oldValue = "" Then

'do nothing

Else

If newValue = "" Then

'do nothing

Else

Destination.Value = oldValue & DelimiterType & newValue

' add new value with delimiter

End If

exitError:

Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

از این لحظه به بعد هر ولیدیشینی در هر سلولی از این شیت وارد بشه، قابلیت انتخاب چندتایی خواهد داشت. (نیازی به تعیین محدوده خاصی نیست)
این کد برای هر شیت قابل اجراست. پس اگر در چند شیت قراره لیست چندتایی داشته باشید، در همه شیت های مورد نظر، کپی کنید.
در این ماکرو، تکرار مجاز است. یعنی یک آیتم میتونه چندین بار انتخاب بشه.
آیتم های انتخابی با , و یک فاصله از هم جدا میشن و در سلول نمایش داده میشن. میتونید این جدا کننده رو در کد تغییر بدید برای این کار کافیه DelimiterType = “, ” یعنی خط هفتم کد قسمت “,” رو به جداکننده دلخواه مثلا “|” تغییر بدید.

۲- ماکروی ورود دیتای چندتایی بدون تکرار (در صورت انتخاب آیتم تکراری، حذف میشه)

وقتی آیتم های یک لیست زیاد باشه، ممکنه در حین انتخاب، اشتباها آیتمی تکراری انتخاب بشه. پس میتونیم از این ماکرو استفاده کنیم که حتی اگه داده تکراری وارد شد، حذف بشه و تکراری ثبت نشه. برای این کار عینا مراحل بالا رو انجام میدیم و فقط این ماکرو رو کپی میکنیم:

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
Dim DelimiterType As String
DelimiterType = ", "
 
If Destination.Count &gt; 1 Then Exit Sub
 
On Error Resume Next
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError
 
If rngDropdown Is Nothing Then GoTo exitError
 
If Intersect(Destination, rngDropdown) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newValue = Destination.Value
  Application.Undo
  oldValue = Destination.Value
  Destination.Value = newValue
    If oldValue &lt;&gt; "" Then
    If newValue &lt;&gt; "" Then
        If oldValue = newValue Or _
            InStr(1, oldValue, DelimiterType &amp; newValue) Or _
            InStr(1, oldValue, newValue &amp; Replace(DelimiterType, " ", "")) Then
            Destination.Value = oldValue
                Else
            Destination.Value = oldValue &amp; DelimiterType &amp; newValue
        End If
    End If
    End If
End If
 
exitError:
  Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

۱۰

۱۱

۱۲

۱۳

۱۴

۱۵

۱۶

۱۷

۱۸

۱۹

۲۰

۲۱

۲۲

۲۳

۲۴

۲۵

۲۶

۲۷

۲۸

۲۹

۳۰

۳۱

۳۲

۳۳

۳۴

۳۵

۳۶

۳۷

۳۸

۳۹

۴۰

۴۱

۴۲

۴۳

۴۴

Option Explicit

Private Sub Worksheet_Change(ByVal Destination As Range)

Dim rngDropdown As Range

Dim oldValue As String

Dim newValue As String

Dim DelimiterType As String

DelimiterType = ", "

If Destination.Count > ۱ Then Exit Sub

On Error Resume Next

Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)

On Error GoTo exitError

If rngDropdown Is Nothing Then GoTo exitError

If Intersect(Destination, rngDropdown) Is Nothing Then

'do nothing

Else

Application.EnableEvents = False

newValue = Destination.Value

Application.Undo

oldValue = Destination.Value

Destination.Value = newValue

If oldValue <> "" Then

If newValue <> "" Then

If oldValue = newValue Or _

InStr(۱, oldValue, DelimiterType & newValue) Or _

InStr(۱, oldValue, newValue & Replace(DelimiterType, " ", "")) Then

Destination.Value = oldValue

Else

Destination.Value = oldValue & DelimiterType & newValue

End If

exitError:

Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

۳- ماکروی ورود دیتای چندتایی بدون تکرار و با امکان حذف

فرض کنید میخواهیم از بین آیتم های انتخاب شده، آیتمی رو حذف کنیم. برای این کار باید کل محتوای سلول رو حذف کنیم و مجدد موارد رو انتخاب کنیم. برای اینکه راحت بتونیم آیتمی رو از بین موارد وارد شده حذف کنیم، باید از ماکروی زیر که قابلیت حذف آیتم ها رو داره استفاده کنیم. بعد از کپی کردن ماکرو، کافیه از روی لیست کشویی، اون آیتم رو انتخاب کنیم. میبینیم که همون آیتم از بین موارد وارد شده در سلول حذف میشن.

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
Dim DelimiterType As String
DelimiterType = ", "
Dim DelimiterCount As Integer
Dim TargetType As Integer
Dim i As Integer
Dim arr() As String
 
If Destination.Count &gt; 1 Then Exit Sub
On Error Resume Next
 
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError
 
If rngDropdown Is Nothing Then GoTo exitError
 
TargetType = 0
    TargetType = Destination.Validation.Type
    If TargetType = 3 Then  ' is validation type is "list"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        newValue = Destination.Value
        Application.Undo
        oldValue = Destination.Value
        Destination.Value = newValue
        If oldValue &lt;&gt; "" Then
            If newValue &lt;&gt; "" Then
                If oldValue = newValue Or oldValue = newValue &amp; Replace(DelimiterType, " ", "") Or oldValue = newValue &amp; DelimiterType Then ' leave the value if there is only one in the list
                    oldValue = Replace(oldValue, DelimiterType, "")
                    oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")
                    Destination.Value = oldValue
                ElseIf InStr(1, oldValue, DelimiterType &amp; newValue) Or InStr(1, oldValue, " " &amp; newValue &amp; DelimiterType)Then
                    arr = Split(oldValue, DelimiterType)
                If Not IsError(Application.Match(newValue, arr, 0)) = 0 Then
                    Destination.Value = oldValue &amp; DelimiterType &amp; newValue
                        Else:
                    Destination.Value = ""
                    For i = 0 To UBound(arr)
                    If arr(i) &lt;&gt; newValue Then
                        Destination.Value = Destination.Value &amp; arr(i) &amp; DelimiterType
                    End If
                    Next i
                Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))
                End If
                ElseIf InStr(1, oldValue, newValue &amp; Replace(DelimiterType, " ", "")) Then
                    oldValue = Replace(oldValue, newValue, "")
                    Destination.Value = oldValue
                Else
                    Destination.Value = oldValue &amp; DelimiterType &amp; newValue
                End If
                Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") &amp; Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces
                Destination.Value = Replace(Destination.Value, DelimiterType &amp; Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))
                If Destination.Value &lt;&gt; "" Then
                    If Right(Destination.Value, 2) = DelimiterType Then  ' remove delimiter at the end
                        Destination.Value = Left(Destination.Value, Len(Destination.Value) - 2)
                    End If
                End If
                If InStr(1, Destination.Value, DelimiterType) = 1 Then ' remove delimiter as first characters
                    Destination.Value = Replace(Destination.Value, DelimiterType, "", 1, 1)
                End If
                If InStr(1, Destination.Value, Replace(DelimiterType, " ", "")) = 1 Then
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", 1, 1)
                End If
                DelimiterCount = 0
                For i = 1 To Len(Destination.Value)
                    If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then
                        DelimiterCount = DelimiterCount + 1
                    End If
                Next i
                If DelimiterCount = 1 Then ' remove delimiter if last character
                    Destination.Value = Replace(Destination.Value, DelimiterType, "")
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
 
exitError:
  Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

۱۰

۱۱

۱۲

۱۳

۱۴

۱۵

۱۶

۱۷

۱۸

۱۹

۲۰

۲۱

۲۲

۲۳

۲۴

۲۵

۲۶

۲۷

۲۸

۲۹

۳۰

۳۱

۳۲

۳۳

۳۴

۳۵

۳۶

۳۷

۳۸

۳۹

۴۰

۴۱

۴۲

۴۳

۴۴

۴۵

۴۶

۴۷

۴۸

۴۹

۵۰

۵۱

۵۲

۵۳

۵۴

۵۵

۵۶

۵۷

۵۸

۵۹

۶۰

۶۱

۶۲

۶۳

۶۴

۶۵

۶۶

۶۷

۶۸

۶۹

۷۰

۷۱

۷۲

۷۳

۷۴

۷۵

۷۶

۷۷

۷۸

۷۹

۸۰

۸۱

۸۲

۸۳

۸۴

۸۵

۸۶

۸۷

۸۸

۸۹

۹۰

Option Explicit

Private Sub Worksheet_Change(ByVal Destination As Range)

Dim rngDropdown As Range

Dim oldValue As String

Dim newValue As String

Dim DelimiterType As String

DelimiterType = ", "

Dim DelimiterCount As Integer

Dim TargetType As Integer

Dim i As Integer

Dim arr() As String

If Destination.Count > ۱ Then Exit Sub

On Error Resume Next

Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)

On Error GoTo exitError

If rngDropdown Is Nothing Then GoTo exitError

TargetType = ۰

TargetType = Destination.Validation.Type

If TargetType = ۳ Then ' is validation type is "list"

Application.ScreenUpdating = False

Application.EnableEvents = False

newValue = Destination.Value

Application.Undo

oldValue = Destination.Value

Destination.Value = newValue

If oldValue <> "" Then

If newValue <> "" Then

If oldValue = newValue Or oldValue = newValue & Replace(DelimiterType, " ", "") Or oldValue = newValue & DelimiterType Then ' leave the value if there is only one in the list

oldValue = Replace(oldValue, DelimiterType, "")

oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")

Destination.Value = oldValue

ElseIf InStr(۱, oldValue, DelimiterType & newValue) Or InStr(۱, oldValue, " " & newValue & DelimiterType)Then

arr = Split(oldValue, DelimiterType)

If Not IsError(Application.Match(newValue, arr, ۰)) = ۰ Then

Destination.Value = oldValue & DelimiterType & newValue

Else:

Destination.Value = ""

For i = ۰ To UBound(arr)

If arr(i) <> newValue Then

Destination.Value = Destination.Value & arr(i) & DelimiterType

End If

Next i

Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))

End If

ElseIf InStr(۱, oldValue, newValue & Replace(DelimiterType, " ", "")) Then

oldValue = Replace(oldValue, newValue, "")

Destination.Value = oldValue

Else

Destination.Value = oldValue & DelimiterType & newValue

End If

Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces

Destination.Value = Replace(Destination.Value, DelimiterType & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))

If Destination.Value <> "" Then

If Right(Destination.Value, ۲) = DelimiterType Then ' remove delimiter at the end

Destination.Value = Left(Destination.Value, Len(Destination.Value) - ۲)

End If

If InStr(۱, Destination.Value, DelimiterType) = ۱ Then ' remove delimiter as first characters

Destination.Value = Replace(Destination.Value, DelimiterType, "", ۱, ۱)

End If

If InStr(۱, Destination.Value, Replace(DelimiterType, " ", "")) = ۱ Then

Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", ۱, ۱)

End If

DelimiterCount = ۰

For i = ۱ To Len(Destination.Value)

If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then

DelimiterCount = DelimiterCount + ۱

End If

Next i

If DelimiterCount = ۱ Then ' remove delimiter if last character

Destination.Value = Replace(Destination.Value, DelimiterType, "")

Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")

End If

Application.EnableEvents = True

Application.ScreenUpdating = True

End If

exitError:

Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

تغییر جداکننده آیتم های انتخابی لیست

جدا کننده آیتم های چندگانه در سلول، در هر ۳ ماکرو، مقدار , است که میتونیم تغییرش بدیم. این جدا کننده با عنوان DelimiterType = “,” در هر ۳ ماکرو نمایش داده شده که در خط ۷ ماکروهاست و میتونیم تغییرش بدیم، مثلا میتونیم ; یا | یا – بذاریم و داده ها با این جدا کننده ها از هم تفکیک بشن.

برای اینکه آیتم ها هر کدوم در یک سطر از سلول ثبت بشن (با Alt Enter از هم تفکیک بشن) باید تغییر دیگه ای در کد ایجاد کنیم اون هم اینکه بجای عبارت

DelimiterType = “,”

بنویسیم:

DelimiterType = vbCrLf

میبنیم که نتیجه بصورت شکل زیر نمایش داده خواهد شد:

شکل ۲- انتخاب آیتم چندگانه با جداکننده Alt Enter

نحوه اجرای ماکرو در شیت محافظت شده (Protected sheet)

برای اینکه بتونیم در یک شیت پروتکت شده، ماکرویی رو اجرا کنیم باید ۲ تا کار انجام بدیم. یکی اینکه اول ماکرو، شیت رو از قفل در بیاریم و بعد که ماکرو اجرا شد، شیت رو مجددا قفل کنیم. برای این کار طبق دستور العمل زیر پیش میریم:

باز کردن قفل قبل از اجرای ماکرو

باید قبل از این خط کد:

Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)

کد زیر رو اضافه کنیم:

ActiveSheet.Unprotect Password:=”password”

در اینجا “password” همون پسورد شیت مورد نظر است که قفل شده.

بعد از این که قفل شکست، ماکرو براحتی اجرا میشه و حالا باید مجدد شیت رو قفل کنیم.

باز کردن قفل قبل از اجرای ماکرو

برای قفل کردن مجدد شیت قبل از کد زیر:

exitError:

این کد رو اضافه میکنیم:

ActiveSheet.Protect Password:=”password”

توجه کنید که password” همون پسورد شیت مورد نظر است که باید با اون قفل بشه.

خب در این مقاله دیدیم که چطور میتونیم امکان انتخاب چندگانه در لیست آبشاری رو فراهم کنیم. این ماکرو رو به فایلتون اضافه کنید و از این امکان فوق العاده استفاده کنید. این کار باعث افزایش کیفیت و دقت ورود داده در اکسل می شود. فراموش نکنید که فایل اکسل بعد از ورود ماکرو بادی بصورت macro enable ذخیهر بشه و الا همه کدها حذف میشه.

برای دیدن ماکروهای کاربردی بیشتر حتما مقاله مربوط به ماکروها آماده در اکسل رو مطالعه کنید.

ویدئو ساخت لیست کشویی پیشرفته

مشاهده این ویدئو در کانال یوتیوب اکسل پدیا

دانلود فایل اکسل لیست پیشرفته

فایل زیر رو دانلود کنید تا نحوه عملکرد هر ۳ ماکرو رو در ۳ شیت ببینید.

توجه: جهت دانلود فایل حتما در حساب کاربری خود وارد شوید.

کلیدواژه : vba ماکرونویسی

حسنا خاکزاد 144

فارغ التحصیل لیسانس مهندسی صنایع، ارشد مدیریت صنعتی از دانشگاه تربیت مدرس و عاشق اکسل هستم. از سال 1388 که ترم 2 لیسانس بودم، به توصیه استاد مشاورم شروع به خوندن اکسل بصورت حرفه ای کردم و همچنان در حال مطالعه و یادگیری و البته آموزش به بقیه هستم.

دیدگاه کاربران

آناهیتا ۵ بهمن ۱۴۰۲ / ۱۲:۲۵ ب٫ظ

پاسخ

سلام و وقت بخیر . من یک سوال در مورد لیست های کشویی به هم پیوسته دارم . من ساختار داده هام به این شکله که فقط دوتا ستون دارم . در ستون اول مثلا اسم قاره ها هست و در ستون دوم اسم کشورها. حالا می‌خوام در یک جدول جداگانه در یک شیت دیگه ، دوتا لیست کشویی ایجاد کنم . لیست اول نام قاره ها و کشویی دوم ، کشورهای مربوط به اون قاره رو فیلتر بکنه .
نکته ای که وجود داره اینه که اسم قاره ها و کشور ها در دو ستونه و من نمیتونم ساختار داده ای رو عوض کنم .( تمام آموزش هایی که در این خصوص دیدم ، ساختار داده ای اینجوری بوده که اسم قاره ها در یک ردیف بوده و اسم کشورها زیر هر قاره به صورت ستونی )
و نکته بعدی اینه که من می‌خوام از این لیست در یک جدول دیگه استفاده کنم که هر روز به رکوردها اضافه میشه و در هر ردیف ، هربار باید این دوتا لیست رو داشته باشم بنابراین نمیتونم یه ستون کمکی ایجاد بکنم چون این ستون کمکی با هر ردیف باید تغییر کنه .
ممنون میشم راهنماییم کنید که چجوری این کار رو انجام بدم
- حسنا خاکزاد ۶ بهمن ۱۴۰۲ / ۱۱:۵۲ ق٫ظ
  
  پاسخ
  
  درود بر شما
  چند حالته
  یا باید تیبل کنید، که نیازمند تغییر ساختاره!
  یا باید فرمول نویسی داینامیک مثل افست و ترکیبش با سایر توابع رو بدونید که بتونید این کار و انجام بددی
  پس چون نمیتونید گزینه اول رو اجرا کنید
  برید سراغ فرمول نویسی ترکیبی برای ایجاد لیست های داینامیک که باتوجه به ساختار موضوع متفاوته
  شاید هم نیاز به یک محدوده واسطه داشته باشید
  یعنی اون دیتای اصلی تغییر کنه|، در یک فضای واسط ساختار رو بسازید و بعد لیست رو اماده کنید

ارسال دیدگاه