[حل شده] درخواست تهیه دستور

[omid0912]

با سلام!
یک فایل براتون ارسال می کنم، لطف کنید دستوراتش رو، روی فایل اجرا کنید. ممنون
(البته من جسارت نمیکنم دستورات اکسل منظور هست سوء تفاهم نشود)!
لطفا دستورات ذیل با یک بار کلیک روی مستعطیل آبی رنگ اجرا گردد .
پس از یک بار کلیک و اجرای دستورات، متن روی مستعطیل آبی از"واریز نشده" به "واریز شد" تغییرنماید ضمنا با کلیک دوم به حالت اول برگردد برای اجرای جدید. یعنی بشه "واریز نشده"
در "Sheet1" , "C3" بترتیب در شیت های 2 و 3 و 4 در زیر تاریخ قرار گیرد
در ادامه "شرح" در "شیت یک" هریک در شیت های خود قرار گیرد.
مبلغ مقابل هر کدام هم به همین صورت.
اما مبلغ هر ایتم اگر صفر بود، تاریخ و شرح و مبلغ مربوطه منظور نگردد.
یک دستور جدا هم لطف کنید روی دایره آبی تهیه کنید که سلول های ستون "J , K" که مشخص هستند با یک بارکلیک پنهان و با کلیک دوم نمایان شود.
با تشکر از شما عزیزان
به اشتباه دو فایل ارسال شده که فایل "Mesal" منظور است.

[M_ExceL]

با سلام!
یک فایل براتون ارسال می کنم، لطف کنید دستوراتش رو، روی فایل اجرا کنید. ممنون
(البته من جسارت نمیکنم دستورات اکسل منظور هست سوء تفاهم نشود)!
لطفا دستورات ذیل با یک بار کلیک روی مستعطیل آبی رنگ اجرا گردد .
پس از یک بار کلیک و اجرای دستورات، متن روی مستعطیل آبی از"واریز نشده" به "واریز شد" تغییرنماید ضمنا با کلیک دوم به حالت اول برگردد برای اجرای جدید. یعنی بشه "واریز نشده"
در "Sheet1" , "C3" بترتیب در شیت های 2 و 3 و 4 در زیر تاریخ قرار گیرد
در ادامه "شرح" در "شیت یک" هریک در شیت های خود قرار گیرد.
مبلغ مقابل هر کدام هم به همین صورت.
اما مبلغ هر ایتم اگر صفر بود، تاریخ و شرح و مبلغ مربوطه منظور نگردد.
یک دستور جدا هم لطف کنید روی دایره آبی تهیه کنید که سلول های ستون "J , K" که مشخص هستند با یک بارکلیک پنهان و با کلیک دوم نمایان شود.
با تشکر از شما عزیزان
به اشتباه دو فایل ارسال شده که فایل "Mesal" منظور است.

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

Sub macro1()

With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))
    If .Fill.ForeColor.RGB = RGB(0, 176, 240) Then
        .Fill.ForeColor.RGB = RGB(146, 208, 80)
        .TextFrame2.TextRange.Characters.Text = "واريز شد"
        Call macro2
    ElseIf .Fill.ForeColor.RGB = RGB(146, 208, 80) Then
        .Fill.ForeColor.RGB = RGB(0, 176, 240)
        .TextFrame2.TextRange.Characters.Text = "واريز نشده"
    End If
End With

End Sub
Sub macro2()
If Sheets(1).Range("g7") > 0 Then
    endr = Sheets(3).Cells(Rows.Count, 2).End(3).Row + 1
    Sheets(3).Cells(endr, 2) = Sheets(1).Cells(3, 3)
    Sheets(3).Cells(endr, 3) = Sheets(1).Cells(7, 5)
    Sheets(3).Cells(endr, 4) = Sheets(1).Cells(7, 7)
End If
If Sheets(1).Range("g9") > 0 Then
    endr = Sheets(2).Cells(Rows.Count, 2).End(3).Row + 1
    Sheets(2).Cells(endr, 2) = Sheets(1).Cells(3, 3)
    Sheets(2).Cells(endr, 3) = Sheets(1).Cells(9, 5)
    Sheets(2).Cells(endr, 4) = Sheets(1).Cells(9, 7)
End If
If Sheets(1).Range("g11") > 0 Then
    endr = Sheets(4).Cells(Rows.Count, 2).End(3).Row + 1
    Sheets(4).Cells(endr, 2) = Sheets(1).Cells(3, 3)
    Sheets(4).Cells(endr, 3) = Sheets(1).Cells(11, 5)
    Sheets(4).Cells(endr, 4) = Sheets(1).Cells(11, 7)
End If
End Sub
Sub Macro3()
If Range("j:j,k:k").EntireColumn.Hidden = True Then
    Range("j:j,k:k").EntireColumn.Hidden = False
Else
    Range("j:j,k:k").EntireColumn.Hidden = True
End If
End Sub

[omid0912]

سلام
عزیزقسمت اول فرمول رو نتونستم روی فایل اصلی پیاده کم
نمیدونم شیپ رو چطوری ربطش دادی؟
من از اکسل هیچ اطلاعاتی ندارم
لطقا با شکل توضیح بدید مرحله به مرحله (البته فقط ارتباط شیپ رو )
ممنون از لطفتون

[M_ExceL]

سلام
عزیزقسمت اول فرمول رو نتونستم روی فایل اصلی پیاده کم
نمیدونم شیپ رو چطوری ربطش دادی؟
من از اکسل هیچ اطلاعاتی ندارم
لطقا با شکل توضیح بدید مرحله به مرحله (البته فقط ارتباط شیپ رو )
ممنون از لطفتون

شرط های کد macro1 از روی رنگ شیپ بررسی می شود شما احتملا رنگ رو تغییر دادید.
macro1 رو به صورت زیر تغییر بدید تا از روی text شیپ، شرط بررسی گردد.

Sub macro1()

With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))
    If .TextFrame2.TextRange.Characters.Text = "واريز نشده" Then
        .Fill.ForeColor.RGB = RGB(146, 208, 80)
        .TextFrame2.TextRange.Characters.Text = "واريز شد"
        Call macro2
    ElseIf .TextFrame2.TextRange.Characters.Text = "واريز شد" Then
        .Fill.ForeColor.RGB = RGB(0, 176, 240)
        .TextFrame2.TextRange.Characters.Text = "واريز نشده"
    End If
End With

End Sub

[omid0912]

شرط های کد macro1 از روی رنگ شیپ بررسی می شود شما احتملا رنگ رو تغییر دادید.
macro1 رو به صورت زیر تغییر بدید تا از روی text شیپ، شرط بررسی گردد.

Sub macro1()

With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))
    If .TextFrame2.TextRange.Characters.Text = "واريز نشده" Then
        .Fill.ForeColor.RGB = RGB(146, 208, 80)
        .TextFrame2.TextRange.Characters.Text = "واريز شد"
        Call macro2
    ElseIf .TextFrame2.TextRange.Characters.Text = "واريز شد" Then
        .Fill.ForeColor.RGB = RGB(0, 176, 240)
        .TextFrame2.TextRange.Characters.Text = "واريز نشده"
    End If
End With

End Sub

سلام
عزیز این خط رو توضیح بدید لطفا
این شیپ رو چطوری ربط داده شده؟
صحبت از رنج کرده
یرای شیپ در متن شیت یک در سلولی خاص فرمولی چیزی فرار دادید؟
With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))

[M_ExceL]

سلام
عزیز این خط رو توضیح بدید لطفا
این شیپ رو چطوری ربط داده شده؟
صحبت از رنج کرده
یرای شیپ در متن شیت یک در سلولی خاص فرمولی چیزی فرار دادید؟
With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))

دوست عزیز با ویژگی range شما یک شیپ یا چندین شیپ رو می تونید از روی نام یا بوسیله index شیپ، مورد انتخاب قرار بدید.
شما range در نظر نگیرید لذا به این صورت هم می تونید بنویسید :

ActiveSheet.Shapes("Rectangle 1").Select

استفاده از عبارت With هم باعث میشه کد رو خلاصه تر بنویسیم و به راحتی به خصوصیات و ویژگی های یک آبجکت دسترسی داشته باشیم.
شما بدون استفاده از With هم می تونید کدتون رو بنویسید.

[omid0912]

دوست عزیز با ویژگی range شما یک شیپ یا چندین شیپ رو می تونید از روی نام یا بوسیله index شیپ، مورد انتخاب قرار بدید.
شما range در نظر نگیرید لذا به این صورت هم می تونید بنویسید :

ActiveSheet.Shapes("Rectangle 1").Select

استفاده از عبارت With هم باعث میشه کد رو خلاصه تر بنویسیم و به راحتی به خصوصیات و ویژگی های یک آبجکت دسترسی داشته باشیم.
شما بدون استفاده از With هم می تونید کدتون رو بنویسید.

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

[حسام بحرانی]

سلام
لطفاً نمونه فایلی که درست کردید رو ارسال کنید تا ارور اون بررسی بشه.
موفق باشید.

[omid0912]

سلام
لطفاً نمونه فایلی که درست کردید رو ارسال کنید تا ارور اون بررسی بشه.
موفق باشید.

سلام
عزیزان بزرگوار لطف می کنید کد مراحل مربوط به تغییر رنگ و تغییر نوشته کلید رو توضیح بدید می خوام یاد بگیرم .
نمی خوام شما فایلم رو اصلاح کنید.
می خوام مراحلش رو یاد بگیرم ارتباط اون شیپ و با کد ها یاد بگیرم.
اگه با شکل نوضیح بدید که دیگه آخر لطفه.
ممنون از شما

[M_ExceL]

سلام
عزیزان بزرگوار لطف می کنید کد مراحل مربوط به تغییر رنگ و تغییر نوشته کلید رو توضیح بدید می خوام یاد بگیرم .
نمی خوام شما فایلم رو اصلاح کنید.
می خوام مراحلش رو یاد بگیرم ارتباط اون شیپ و با کد ها یاد بگیرم.
اگه با شکل نوضیح بدید که دیگه آخر لطفه.
ممنون از شما

Sub macro1()

With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))

'>>>  در این مرحله اگر رنگ شیپ آبی بود به رنگ سبز در میاد سپس ماکرو  2 را اجرا می کند متن شیپ نیز به واریز شد تغییر می کند
    If .Fill.ForeColor.RGB = RGB(0, 176, 240) Then
        .Fill.ForeColor.RGB = RGB(146, 208, 80)
        .TextFrame2.TextRange.Characters.Text = "واريز شد"
        Call macro2

'>>> در این مرحله اگر رنگ شیپ سبز بود به رنگ آبی در میاد متن شیپ نیز به واریز نشده تغییر می کند
    ElseIf .Fill.ForeColor.RGB = RGB(146, 208, 80) Then
        .Fill.ForeColor.RGB = RGB(0, 176, 240)
        .TextFrame2.TextRange.Characters.Text = "واريز نشده"
    End If
End With

[omid0912]

[QUOTE=M_ExceL;74171][CODE]
Sub macro1()

With ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1"))

'>>> در این مرحله اگر رنگ شیپ آبی بود به رنگ سبز در میاد سپس ماکرو 2 را اجرا می کند متن شیپ نیز به واریز شد تغییر می کند
If .Fill.ForeColor.RGB = RGB(0, 176, 240) Then
.Fill.ForeColor.RGB = RGB(146, 208, 80)
.TextFrame2.TextRange.Characters.Text = "واريز شد"
Call macro2

'>>> در این مرحله اگر رنگ شیپ سبز بود به رنگ آبی در میاد متن شیپ نیز به واریز نشده تغییر می کند
ElseIf .Fill.ForeColor.RGB = RGB(146, 208, 80) Then
.Fill.ForeColor.RGB = RGB(0, 176, 240)
.TextFrame2.TextRange.Characters.Text = "واريز نشده"
End If
End With

من هیچ اطلاعاتی از اکسل ندارم
ممکنه لطف بفرمایید
مطالب بالا رو فرامش کنید لطقا
یک دستورکلیشه ای برام بنویسید که روی فایلی که دارم (فایل کاری و حجیم هستش) پیاده کنم
کلیشه ای باشه که در جاهای مختلف لازم هستش. این رو هم در نظر داشته باشید که چند تا سلول و ستون رو تغیر نام دادم.(که از آموخنه های قبلم توسط دوستان هستش) که سطر یا ستون کم و زیاد کردم بهم نخوره.
ابتدای کار یک کلید می خوام که هم رنگش تغییر کنه هم متنش در حال حاضر اون کلید صرفا اطلاعات رو انتقال میده می خوام ضمن انتقال اطلاعات هم رنگش تغییر کنه هم متنش
لطف کنید از صفر برام توضیح بدید که بعد از باز کردن اکسل چه باید بکنم. بهم نخدید هیچی بلد نیستم.
ببخشید که اذیت میشید.

[omid0912]

بالاخره درست شد!!!
ممنون عزیزان