تنسيق تلقائى لجميع ورقات العمل اعتمادا على الصفحة الرئيسية

[رضا راغب]

السلام عليكم اخوانى الاجلاء

ومساكم الله بالخير 

أبحث عن كود لتسيق تلقائى لجميع ورقات العمل اعتمادا على الصفحة الرئيسية

لدىّ ملف مكون من 10 شيتات جميعهم بنفس التنسيق 

ماأريده هنا مع تغير تنسيق الورقة الرئيسية " sheet1 "

من تغييرنوع الخط وسمك الخط وطول وعرض الصفوف والاعمدة

يتم التغيير تلقائيا  بباقى شيتات الملف

دمتم فى امان الله وشكرا جزيلا 

تنسيق تلقائى.xlsb.rar

تم تعديل أكتوبر 30, 2015 بواسطه رضا راغب

[بن علية حاجي]

السلام عليكم ورحمة الله

أخي الكريم رضا، لأجل هذا الغرض تم إضافة كود في حدث WORKBOOK والذي يتم تنفيذه تلقائيا بمجرد الانتقال لأي شيت في المصنف (الملف)... أرجو أن يكون في الملف المرفق بعض المطلوب...

بن علية

تنسيق تلقائى.xlsb.rar

[الـعيدروس]

السلام عليكم

وهذا كود اخر اضافة الى حل الاستاذ الفاضل بن عليه

يقوم بأخذ تنسيقات الورقة الرئيسيه من عرض للاعمد والصفوف

والخط والبوردر

Sub Formt_Ali()
Dim Sht As Worksheet
Dim Sh As Worksheet
Dim Rw&, Col$
Set Sht = Sheets("الرئيسية")
With Application
     .ScreenUpdating = False
     .EnableEvents = True
With Sht
Rw = Split(.UsedRange.Address, "$")(4): Col = Split(.UsedRange.Address, "$")(3)
.Range("A1:" & Col & Rw).Copy
For Each Sh In Sheets
Ali_Wdth Sht, Sh, True, True
 If Not Sh.Name = .Name Then
    With Sh
       With .Range("A1:" & Col & Rw)
         .PasteSpecial xlPasteFormats
       End With
    End With
 End If
Next Sh
End With
    .CutCopyMode = False
    .ScreenUpdating = True
    .EnableEvents = False
End With
End Sub
Private Sub Ali_Wdth(ByVal Smp_Sht As Variant, ByVal Al_Sht As Variant, Optional Heights As Boolean = False, Optional Widths As Boolean = False)
  Dim Sc_Rn As Range, D_Rn As Range
  Dim R As Long, C As Long
  On Error GoTo Eri
  With Smp_Sht
    Set Sc_Rn = Range(.Cells(1, 1), .UsedRange.Cells(.UsedRange.Cells.Count))
  End With
  With Al_Sht
    Set D_Rn = Range(.Cells(1, 1), .UsedRange.Cells(.UsedRange.Cells.Count))
  End With
  R = WorksheetFunction.Max(Sc_Rn.Rows.Count, D_Rn.Rows.Count)
  C = WorksheetFunction.Max(Sc_Rn.Columns.Count, D_Rn.Columns.Count)
  Set Sc_Rn = Sc_Rn.Resize(R, C)
  Set D_Rn = D_Rn.Resize(R, C)
  If Heights Then
    For R = 1 To R
      D_Rn.Rows(R).RowHeight = Sc_Rn.Rows(R).RowHeight
    Next
  End If
  If Widths Then
    For C = 1 To C
      D_Rn.Columns(C).ColumnWidth = Sc_Rn.Columns(C).ColumnWidth
    Next
  End If
Eri:
End Sub

 

[رضا راغب]

السلام عليكم ورحمة الله

أخي الكريم بن عليه

تحية الله عليك

أحسنت أحسنت 

والله ياأخى هذا هو المطلوب

بارك الله فيك وشكرا جزيلا 

دمتم فى رعاية الله

 

تم تعديل أكتوبر 30, 2015 بواسطه رضا راغب

[رضا راغب]

أخى الكريم بن عليه

بارك الله فيك 

والله ماقصرت أحببت أن أبدى إعجابى بمشاركة الطيبة

فعلى مايبدو وكونى حديث العهد بالمنتدى فلن يسمح لى بذلك

اسمح ان اشكرك وابدى اعجابى لشخصكم الكريم

واتوجه للشكر لاخى الفاضل العيدروس

دمتم فى رعاية الله

[رضا راغب]

أخى الكريم بن عليه

عذرا اخى كيف يمكن إستثناء الشيت الاول والثانى

على اعتبار انهم خارج التنسيق التلقائى لاحتوائهم على بيانات ثابته

دمتم فى امان الله وشكرا جزيلا

[بن علية حاجي]

السلام عليكم ورحمة الله

أخي الكريم رضا، في هذه الحالة يجب إضافة أمر للكود باستعمال الدالة IF فيه نقوم باستثناء الشيت الأول والثاني أو غيرهما (بأسمائها) كما فعلت في الكود المعدل في الملف المرفق... أرجو أن تصل الفكرة...

أخوك بن علية

 

تنسيق تلقائى.rar

تم تعديل أكتوبر 31, 2015 بواسطه بن علية حاجي

[محمد حسن المحمد]

السلام عليكم أستاذنا المحترم

كود رائع تم نسخ الورقة الأولى ثم لصق التنسيق في الصفحات التي يتم فتحها

جزاكم الله خيراً...وإلى المزيد من التقدم والعطاء..

ما شاء الله بارك الله..

والسلام عليكم.

[رضا راغب]

أخى الكريم بن عليه

اشكرك شكرا جزيلا

المقصود بإستثناء الشيت الاول والثانى موضح بالملف

حيث أن الشيتين يحتويا على بيانات من خلالها يتم عمل قوائم منسدلة

وإلى طلب على إستحياء بالرابط 

http://www.officena.net/ib/topic/64486-طلب-إضافة-رسائل-على-كود-نقل-بيانات-كل-10-ثوانى/

وجزاكم الله خيرا

دمتم فى امان الله 

تم تعديل أكتوبر 31, 2015 بواسطه رضا راغب

[رضا راغب]

up

[رضا راغب]

أخى الكريم الاستاذ القدير بن عليه

السلام عليكم

شاكر فضل حضرتك تم التعديل لاستثناء الشيت الاول والثانى هذا فى حالة ما إذا كان المصنف جميع بياناته واحدة

فهل من كود أخر نستطيع من خلاله التحكم فى تنسيق الخلايا لعدة أوراق حيث يؤثر هذا الكود سلبا

على البيانات المدخلة وخاصة مع الانتقال من شيت لاخر

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.ScreenUpdating = False
  If ActiveSheet.Name <> "الرئيسية" And ActiveSheet.Name <> "Sheet1" Then
  If ActiveSheet.Name <> "الرئيسية" And ActiveSheet.Name <> "Sheet2" Then
    Sheets("الرئيسية").Cells.Copy
    On Error Resume Next
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
    Range("A1").Select
  End If
    Application.CutCopyMode = False
Application.ScreenUpdating = True
  End If
End Sub

تقبل وافر تقديرى واحترامى

تم تعديل نوفمبر 2, 2015 بواسطه رضا راغب