اعمال خودکار فرمت سلول یا ردیف بر روی سلول دیگر

**Behnam** · 2018/07/15, 14:31

شما باید از قوانین مربوط به Table استفاده کنید دوست عزیز
دو پست زیر رو مطالعه کنید
۲۳ نکته جداول اکسل (۱) - جدول اكسل - Excel Table - جامعه اکسل ایرانیان
۲۳ نکته جداول اکسل (۲) - جامعه اکسل ایرانیان

**habib100** · 2018/07/15, 16:34

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

**M_ExceL** · 2018/07/15, 21:13

نوشته اصلی توسط habib100

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

سلام
اگر می خواین از vba استفاده کنید، داخل ایونت Change شیت ثبت هزینه کد زیر رو قرار بدید :

کد:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim rn(1 To 6) As Byte
rn(1) = Range("a" & Rows.Count).End(xlUp).Row
rn(2) = Range("b" & Rows.Count).End(xlUp).Row
rn(3) = Range("c" & Rows.Count).End(xlUp).Row
rn(4) = Range("d" & Rows.Count).End(xlUp).Row
rn(5) = Range("e" & Rows.Count).End(xlUp).Row
rn(6) = Range("f" & Rows.Count).End(xlUp).Row
lstr = Application.WorksheetFunction.Max(rn)
    With Range("A" & lstr & ":f" & lstr)
        .Font.Name = "Calibri"
        .Font.Size = 11
        .Font.Strikethrough = False
        .Font.Super****** = False
        .Font.Sub****** = False
        .Font.OutlineFont = False
        .Font.Shadow = False
        .Font.Underline = xlUnderlineStyleNone
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .Font.ThemeFont = xlThemeFontMinor

        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        .Borders(xlEdgeLeft).TintAndShade = 0
        .Borders(xlEdgeLeft).Weight = xlHairline

        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).ColorIndex = 0
        .Borders(xlEdgeTop).TintAndShade = 0
        .Borders(xlEdgeTop).Weight = xlThin

        .Borders(xlEdgeBottom).LineStyle = xlDash
        .Borders(xlEdgeBottom).ColorIndex = 0
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlThin

        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).ColorIndex = xlAutomatic
        .Borders(xlEdgeRight).TintAndShade = 0

        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).ColorIndex = xlAutomatic
        .Borders(xlInsideVertical).TintAndShade = 0
        .Borders(xlInsideVertical).Weight = xlHairline

        .Borders(xlInsideHorizontal).LineStyle = xlNone

        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext

        .Interior.Pattern = xlNone
        .Interior.TintAndShade = 0
        .Interior.PatternTintAndShade = 0
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

موفق باشید.

**habib100** · 2018/07/16, 09:34

سلام
ممنون هستم، فقط از دو خط .Font.Super****** = False و .Font.Sub****** = False ایراد می گیرد که پاکشون کردم درست شد و فرمت جدولی که اعمال می شود با فرمت جدول ردیف بالایی تفاوت دارد.

**M_ExceL** · 2018/07/16, 17:22

نوشته اصلی توسط habib100

سلام
ممنون هستم، فقط از دو خط .Font.Super****** = False و .Font.Sub****** = False ایراد می گیرد که پاکشون کردم درست شد و فرمت جدولی که اعمال می شود با فرمت جدول ردیف بالایی تفاوت دارد.

سلام
علت اون خطا فیلتر سایت هستش، برخی کلمات تبدیل به ستاره میشن.
در مورد مشکل فرمت هم ، بعد از خط end with کد زیر رو قرار بدید :

کد:

With Range("c3" & ":e" & lstr)
.NumberFormat = "$ #,##0_-"
.Font.Bold = True
End With

موفق باشید.

**habib100** · 2018/07/17, 08:06

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