اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


الردود الموصى بها

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

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

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

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

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

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

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

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

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

تم تعديل بواسطه رضا راغب
رابط هذا التعليق
شارك

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

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

بن علية

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

  • Like 2
رابط هذا التعليق
شارك

السلام عليكم

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

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

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

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

 

  • Like 3
رابط هذا التعليق
شارك

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

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

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

أحسنت أحسنت 

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

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

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

 

تم تعديل بواسطه رضا راغب
رابط هذا التعليق
شارك

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

بارك الله فيك 

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

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

أخوك بن علية

 

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

تم تعديل بواسطه بن علية حاجي
  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

تم تعديل بواسطه رضا راغب
رابط هذا التعليق
شارك

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

السلام عليكم

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

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

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

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

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

تم تعديل بواسطه رضا راغب
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information