أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على ali mohamed ali-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة منع ادخال البيانات بعدة شروط اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





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

الاساتذه الكرام كيف اجعل الكود يواصل العمل والترحيل عند عدم الرغبة في الطباعة بعض المرات ومرات احتاج الطباعة [code] ..



03-05-2020 02:05 مساء
ابوعلي الحبيب
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 05-05-2018
رقم العضوية : 6082
المشاركات : 235
الجنس : ذكر
تاريخ الميلاد : 1-1-1990
يتابعهم : 2
يتابعونه : 1
قوة السمعة : 168
 offline 

الاساتذه الكرام 

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

ومرات احتاج الطباعة
Sub طباعة()
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Msg = "* هل تريد الطباعة  * "
ans = MsgBox(Msg, vbYesNo, "                   طباعة  ")
If ans = vbYes Then
Else
Exit Sub
End If
Application.Dialogs(xlDialogPrinterSetup).Show
 
    Dim Numcop As Long
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        ElseIf Len(Numcop) > 0 Then
        End If
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
    Dim FS As Worksheet, TS As Worksheet
 
 
    Dim WS As Worksheet, SH As Worksheet
    Dim x As Long, i As Long, Arr
    Set WS = Sheets("عهدة"): Set SH = Sheets("data")
    x = SH.Cells(Rows.Count, 3).End(3).Row + 1
            Arr = Array("a4", "B4", "C4", "D4", "E4", "F4")
            For i = LBound(Arr) To UBound(Arr)
                If Arr(i) <> "" Then Arr(i) = WS.Range(Arr(i)).Value
                If IsEmpty(Arr(i)) Then MsgBox "البيانات غير كاملة يرجى إكمال كافة الحقول": Exit Sub
            Next i
            With SH
                .Cells(x, 1) = .Cells(x, 1).Row - 2
                .Cells(x, 2).Resize(, UBound(Arr) + 1) = Arr
            End With
  
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub






ولكم جزيل الشكر
 
 
  هل تريد الطباعة .xlsm   تحميل xlsm مرات التحميل :(9)
الحجم :(41.6) KB

توقيع :ابوعلي الحبيب
( خير الناس انفعهم للناس) 113142


03-05-2020 03:06 مساء
مشاهدة مشاركة منفردة [1]
نصر الإيمان
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 15-02-2018
رقم العضوية : 4397
المشاركات : 446
الجنس : ذكر
تاريخ الميلاد : 29-12-1985
يتابعهم : 8
يتابعونه : 4
قوة السمعة : 885
 offline 
look/images/icons/i1.gif كيف اجعل الكود يواصل العمل والترحيل عند عدم الرغبة في الطباعة
ممكن توضيح اكثر . . . لو سمحت ؟؟؟؟

03-05-2020 03:57 مساء
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif كيف اجعل الكود يواصل العمل والترحيل عند عدم الرغبة في الطباعة
السلام عليكم أخي الكريم أبو علي
يراعى عند كتابة الأكواد أن تقوم بعملية التنظيم والترتيب لما تريده بالضبط
طبعاً لم تقم بتوضيح التفاصيل وهذه ليست المرة الأولى ولكن حسب ظني أنك تريد إظهار رسالة للمستخدم بأن يقوم بعملية الترحيل من عدمه أيضاً ليكون الكود أكثر مرونة ..
عموماً جرب الكود التالي وحاول دراسة الكود لتستفيد منه في أمور أخرى
Sub Test()
    Dim ws As Worksheet, sh As Worksheet, m As Long, x As Long
    
    UseSpeedyCode True
        If MsgBox("Do You Want To Print?", vbYesNo + vbQuestion) = vbYes Then
            Application.Dialogs(xlDialogPrinterSetup).Show
            x = Application.InputBox("Enter Copies", "Copies Number", 1, Type:=1)
            If x > 0 Then ActiveWindow.SelectedSheets.PrintOut Copies:=x
        End If
            
        If MsgBox("Do You Want To TransferData?", vbYesNo + vbQuestion) = vbNo Then GoTo Skipper
            
        Set ws = ThisWorkbook.Worksheets(1)
        Set sh = ThisWorkbook.Worksheets(2)
        With sh
            m = .Cells(Rows.Count, 3).End(3).Row + 1
            .Cells(m, 1).Value = .Cells(m, 1).Row - 2
            .Cells(m, 2).Resize(1, 6).Value = ws.Cells(4, 1).Resize(1, 6).Value
        End With
Skipper:
    UseSpeedyCode False
End Sub

Public Function UseSpeedyCode(goFast As Boolean)
    Dim calc As Long
    With Application
        .ScreenUpdating = Not goFast
        .EnableEvents = Not goFast
        If goFast Then
            calc = .Calculation
            .Calculation = xlCalculationManual
        Else
            .Calculation = calc
        End If
    End With
End Function

04-05-2020 11:14 صباحا
مشاهدة مشاركة منفردة [3]
ابوعلي الحبيب
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 05-05-2018
رقم العضوية : 6082
المشاركات : 235
الجنس : ذكر
تاريخ الميلاد : 1-1-1990
يتابعهم : 2
يتابعونه : 1
قوة السمعة : 168
 offline 
look/images/icons/i1.gif كيف اجعل الكود يواصل العمل والترحيل عند عدم الرغبة في الطباعة
الأستاذ الفاضل  /  YasserKhalil

ماشاء الله تبارك الله عليك
بالفعل هذا هو المطلوب 

كل الشكر والتقدير لك ولجميع 
من ساعدني في 
هذا المنتدى الرائع
جزاكم الله خير  
توقيع :ابوعلي الحبيب
( خير الناس انفعهم للناس) 113142


04-05-2020 11:21 صباحا
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif كيف اجعل الكود يواصل العمل والترحيل عند عدم الرغبة في الطباعة
وجزيت خيراً أخي الكريم أبو علي
أنصحك بمحاولة دراسة الكود وفهم كل الأسطر الموجودة وإذا تعثرت في نقطة محددة في فهم جزئية أخبرنا بها لنوضحها لك ، بحيث تتمكن من مساعدة غيرك كما تمكنت أنا من مساعدتك ، فدائرة الحياة الأخذ والعطاء لا الأخذ فقط ، وصدقني في العطاء ستجد نفسك تستفيد أكثر من الأخذ
والله الموفق لما فيه الصلاح والخير للجميع




الكلمات الدلالية
اجعل ، الكود ، يواصل ، العمل ، والترحيل ، الرغبة ، الطباعة ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 12:53 صباحا