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

علامة مائية مميزة


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

ايها الاخوة الاحباب

السلام عليكم ورحمته الله بركاته

بالبحث عن المواضيع التى تتعلق بالعلامة المائية فى الاكسيل وجدت هذا الموضوع المميز

للأخ الفاضل الاستاذ القدير / العيدروس " أبوعلى " وهو أفضل موضوع من وجهة نظرى للعلامات المائية فى الاكسيل

وحتى لاأطيل على حضراتكم المطلوب فى هذا الموضوع هو كيفية طباعة العلامة المائية المرفقة بهذا المثال

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

شاكر فضل الجميع **** وجزاكم الله خيرا

علامة مائية مميزة.rar

تم تعديل بواسطه ناصرالمصرى
رابط هذا التعليق
شارك

أخى العزيز الاستاذ / محمود

السلام عليكم ورحمته الله وبركاته

بارك الله فيكم وأعزكم وإيانا بالاسلام

الموضوع انى أريد بإذن الله طباعة  " لوجو الشركة " كعلامة مائية فى فاتورة البيع وكذا إذون الصرف

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

أما عن كود الاخ الفاضل الاستاذ / العيدروس يتم تنفيذه على كامل أوراق المصنف دون إستثناء

وهناك السطور التالية من الكود هل لها علاقة بأبعاد الصورة المرفقة أرجو التوضيح

 

        If .Orientation = xlPortrait Then
            .HeaderMargin = Application.InchesToPoints(3)
            ElseIf .Orientation = xlLandscape Then
            .HeaderMargin = Application.InchesToPoints(3.5)

أرجو أن أكون وفقت فى توضيح الامور علما بأن الاوراق الثمانية

يتخللها أعمدة مخفية واعتقد انها لاتؤثر على المطلوب فى شيىء

شاكر جدا إهتمام حضرتك ***** وجزاكم الله خيرا

 

تم تعديل بواسطه ناصرالمصرى
رابط هذا التعليق
شارك

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

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

بن علية

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

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

وعليكم السلام ورحمته الله وبركاته

والله حاولت ولم ينجح الامر معى فكيف يكون ذلك

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

شاكر فضل حضرتك **** وجزاكم الله خيرا

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

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

أخي الكريم، يجب أيضا تغيير الأمر

.CenterHeader = "&G"

بالأمر

.CenterHeader = ""

كما فعلتُ في الملف المرفق وسميت الكود Omar_Pr...

بن علية

علامة مائية مميزة.rar

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

وعليكم السلام ورحمته الله وبركاته

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

تمام الله يبارك فيك

برجاء ملاحظة الورقتين الثانية " أوفسينا " والرابعة " الاول "

هاتان الورقتان لايظهر بهما العلامة مع عمل معاينة للطباعة مع الكود الخاص بكم

شاكر فضل حضرتك **** وجزاكم الله خيرا

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

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

وعليكم السلام ورحمته الله وبركاته

تم عمل معاينة وطباعة جميع الصفحات المراد طباعة العلامة بهم

ولكن لن يتم طباعة الورقتين سالفتى الذكر  فهل من سبيل لاظهارهم فى الطباعة

شاكر فضل حضرتك **** وجزاكم الله خيرا

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

بعد اذن الاخوة الكرام

تفضل اخي تعديل بسيط لتطبيق على الشيتات دفعه واحده

Private Const Nm As String = "dd.jpg"
Public Sub Ali_Pr()
    Dim Pth As String
    Dim arr(), sh
    arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13)
    For sh = LBound(arr) To UBound(arr)
        Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm
        Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth
        With Sheets(arr(sh)).PageSetup
            .CenterHeader = "&G"
            If .Orientation = xlPortrait Then
                .HeaderMargin = Application.InchesToPoints(3)
            ElseIf .Orientation = xlLandscape Then
                .HeaderMargin = Application.InchesToPoints(3.5)
            End If
        End With
    Next
    MsgBox "Done....(-_-)..."
End Sub

الشيتات المراد التعديل  عليها داخل مصفوفة تستطيع تحديد اي شيتات تريد
تحياتي

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

بسم الله ماشاء الله عليك ياأبو العربى

 ربنا يحميك لاولادك ياحاج ياسر **** ولاتغيب عننا وعموما المسافة مش بعيدة

   يدوبك 28 ك **** هذا ما أحتاجة تحديدا 

أطمع فى إضافة أمر لطباعة التسع ورقات وبعد الطباعة مسح محتوى الجدوال

تمهيدا لادخال بيانات جديدة **** بمعنى أخر استبدال الرسالة الاخيرة برسالة اخرى

هل تود طباعة الاوراق المحددة طبعا هشغل الكتالوج واقول له مافيش مانع

و لا تنسى عدد النسخ المراد طباعتها  وبعدين امر المسح ****شاكر فضلكم جميعا ***** وجزاكم الله خيرا

 
تم تعديل بواسطه ناصرالمصرى
رابط هذا التعليق
شارك

لما الطمع أخي الكريم ناصر في نفس الموضوع

اطرح موضوع جديد لكل طلب جديد ..هذا أفضل وأيسر للباحث فيما بعد

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

اليوم يوم سعدى وهنائى

بمشاركة القدير الاستاذ بن عليه حاجى والاستاذ القدير محمود الشريف

وها قد رزقنى الله بالتوأمين ياسر العربى الشرقاوى الاصيل

وياسر خليل ابن مطروح الغالى الذى سيضع بصمته الاخيرة فى هذا الموضوع **** حماكم الله جميعا

شاكر فضلكم جميعا وجزاكم الله خيرا

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

تفضل حبيبي 
 

Private Const Nm As String = "dd.jpg"
Public Sub Ali_Pr()
    Dim Pth As String, msg As String, x
    Dim arr(), sh
    arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13)
    For sh = LBound(arr) To UBound(arr)
        Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm
        Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth
        With Sheets(arr(sh)).PageSetup
            .CenterHeader = "&G"
            If .Orientation = xlPortrait Then
                .HeaderMargin = Application.InchesToPoints(3)
            ElseIf .Orientation = xlLandscape Then
                .HeaderMargin = Application.InchesToPoints(3.5)
            End If
        End With
    Next
    msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة")
    If msg = vbYes Then
        x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة")
       Sheets(arr).PrintOut Copies:=x
    End If
    MsgBox "Done....(-_-)..."
End Sub

تحياتي

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

فضلك الله تعالى ياأبو العربى

وجزاكم الله تعالى خيرا

لسه على الحلو تكة ويبقى كدة رضا

طبعا انا لا أطلب الا بعد محاولات وخصوصا ان الموضوع تم تنفيذه بالمصفوفات

ودى بتعملى برجله حبتين *** أرجو منك أخى وحبيبى ياسر

اعطاء أمر أخير بمسح كافة الاوراق التسعة بعد أمر الطباعة

وذلك بداية من الخلية A9 الى V  وحتى إخر صف على اعتبار أن البيانات هنا متغيرة

شاكر فضلك وفضل الجميع وجزاكم الله خيرا

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

اتفضل التكه ويبقى كدا رضا
 

Private Const Nm As String = "dd.jpg"
Public Sub Ali_Pr()
    Dim Pth As String, msg As String, x
    Dim arr(), sh
    arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13)
    For sh = LBound(arr) To UBound(arr)
        Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm
        Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth
        With Sheets(arr(sh)).PageSetup
            .CenterHeader = "&G"
            If .Orientation = xlPortrait Then
                .HeaderMargin = Application.InchesToPoints(3)
            ElseIf .Orientation = xlLandscape Then
                .HeaderMargin = Application.InchesToPoints(3.5)
            End If
        End With
    Next
    msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة")
    If msg = vbYes Then
        x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة")
        Sheets(arr).PrintOut Copies:=x
        For sh = LBound(arr) To UBound(arr)
            Sheets(arr(sh)).Range("A9:V" & Sheets(arr(sh)).Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
        Next
    End If
    MsgBox "Done....(-_-)..."
End Sub

تحياتي

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

حبيى ابو العربى

ده كدة مش رضا وبس 

دا أنا ابوس إيدى وإيدك وش وظهر على هذة الروح الطيبة

شاكر فضلك وفضل الجميع وجزاكم الله خيرا

 

 

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

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.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information