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

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

قام بنشر

السلام عليكم 
سؤال لخبراء الاكسل الكرام

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

Sub Macro01()
 
 
 
a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")
 
' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If a = vbYes Then
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:""كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        ElseIf Len(Numcop) > 0 Then
        End If
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
 'اذ اخترت لا اريد الطباعة  عدد الصحيح الكود يقف ويلغي التنفيذ كذالك  هنا
 
End With
End If
    

 
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
  
End Sub


ولكم الشكر 

تنفيذ المكرووو.rar

  • Like 1
قام بنشر
 Sub Macro01()
 
 
 
a = MsgBox("åá  ÊÑíÏ ØÈÇÚÉ ÇáÇä  ¿", vbYesNo + vbQuestion, "ØÈÇÚÉ")
 
' ÇÐ ÇÎÊÑÊ áÇ ÇÑíÏ ÇáØÈÇÚÉ ÇáÕÍíÍ ÇáßæÏ íÞÝ æíáÛí ÇáÊäÝíÐ åäÇ
If a = vbNo Then  ' هنا تمت إضافة اختيار no 
Exit Sub
End If
If a = vbYes Then
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("ÃÏÎá ÚÏÏ ÇáäÓÎ ááØÈÇÚÉ:", "ßã ÚÏÏ ÇáäÓÎ?", 1, Type:=1)
        If Numcop = 0 Then
        ElseIf Len(Numcop) > 0 Then
        End If
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
 'ÇÐ ÇÎÊÑÊ áÇ ÇÑíÏ ÇáØÈÇÚÉ  ÚÏÏ ÇáÕÍíÍ ÇáßæÏ íÞÝ æíáÛí ÇáÊäÝíÐ ßÐÇáß  åäÇ
 
End With
End If
    

 
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
  
End Sub

أرجو أن يكون هذا التعديل المطلوب

كل عام و أنت بخير

  • Like 1
قام بنشر (معدل)

 استاذي

بعد هذا الكود و اذا ظهرة نافذة عدد النسخة للطباعة واخترت الغاء الكود يستمر في تنفيذ الامر

  والمطلوب اذا لم اختر العدد وقررت الغاء الطباعة

ان يقف الكود ويتم الخروج من الامر

Dim Numcop As Integer
         Numcop = Application.InputBox("ادخل عدد النسخ المطلوب طباعتها ", 1, Type:=1)
        If Numcop = 0 Then
        ElseIf Len(Numcop) > 0 Then
        End If
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop

 

 

تم تعديل بواسطه ابوعلي الحبيب
  • Like 1
قام بنشر
4 ساعات مضت, ابوعلي الحبيب said:

 استاذي

بعد هذا الكود و اذا ظهرة نافذة عدد النسخة للطباعة واخترت الغاء الكود يستمر في تنفيذ الامر

  والمطلوب اذا لم اختر العدد وقررت الغاء الطباعة

ان يقف الكود ويتم الخروج من الامر

 

اعتقد ان ده منطقي انه لا يقبل الغاء المهمه لان الاختيار عند الرساله فقط وليس عند الطباعه

 

 

  • Like 1
قام بنشر

جرب هذا الكود لعله يفي بالغرض  في حالة الوافقة يظهر صندوق حواري لكتابة رقم أول صفحة في الطباعة  اكتب رقم البداية ثم اضغط ok

يظهر صندوق حواري لكتابة رقم آخر صفحة في الطباعة اكتب رقم النهاية ثم اضغط ok

Sub طباعةمدىمن_الصفحات()


A = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")

' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If A = vbYes Then
Dim startpage As Integer
Dim endpage As Integer
startpage = InputBox("من فضلك أدخل رقم أول صفحة المراد طباعتها.", " رقم أول صفحة في الطباعة")
If Not WorksheetFunction.IsNumber(startpage) Then
MsgBox "Invalid Start Page number. Please try again.", "Error"
Exit Sub
End If
endpage = InputBox("من فضلك أدخل رقم آخر صفحة المراد طباعتها.", "رقم آخر صفحة في الطباعة ")
If Not WorksheetFunction.IsNumber(endpage) Then
MsgBox "Invalid End Page number. Please try again.", "Error"
Exit Sub
End If
ActiveWindow.SelectedSheets.PrintOut From:=startpage, To:=endpage, Copies:=1, Collate _
:=True
End If
    
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
 
End Sub

 

  • Like 1
قام بنشر

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


Sub Macro01()

 

a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")

' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If a = vbYes Then
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        Exit Sub
        ElseIf Len(Numcop) > 0 Then
        End If
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
 'اذ اخترت لا اريد الطباعة  عدد الصحيح الكود يقف ويلغي التنفيذ كذالك  هنا
 
End With
End If
    
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
 
End Sub

 

قام بنشر

اشكرك استاذي على تفاعلك

 استاذي  صحيح الكود يلغي الطباعه ولكن
مازالت المشكلة قائمة 
حيث انه يتم الترحيل  الان (رغم الغاء الامر الاول من النافذة الاولى)
يفترض ان يخرج ويقف من تنفيذ الامر كله طباعه وترحيل

 

قام بنشر

جرب هذا التعديل ربما يكون ما تريده

 Sub Macro01()

 

a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")

' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If a = vbYes Then
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        Exit Sub
        ElseIf Len(Numcop) > 0 Then
        End If
        a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")
If a = vbNo Then
 Exit Sub

 Else
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
 'اذ اخترت لا اريد الطباعة  عدد الصحيح الكود يقف ويلغي التنفيذ كذالك  هنا
 End If
End With
End If
    
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
 
End Sub

 

قام بنشر

تفضل اخى الكريم هذا كود الأستاذ الكبير ياسر خليل لعله يفى بالغرض

Sub Macro01()
    Dim x3          As Long
    Dim x4          As Long

    a = MsgBox("åá  ÊÑíÏ ØÈÇÚÉ ÇáÇä  ¿", vbYesNo + vbQuestion, "ØÈÇÚÉ")

    If a = vbYes Then
        With ActiveSheet
            Dim Numcop As Integer
            Numcop = Application.InputBox("ÃÏÎá ÚÏÏ ÇáäÓÎ ááØÈÇÚÉ:", "ßã ÚÏÏ ÇáäÓÎ?", 1, Type:=1)
            If Numcop = 0 Then
                Exit Sub
            ElseIf Len(Numcop) > 0 Then
                ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
                Exit Sub
            End If
        End With

Skipper:
        x3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
        x4 = Sheets("aaa").Range("B24").End(xlUp).Row
        Sheets("DATA").Range("B" & x3).Resize(x4 - 5, 21) = Sheets("aaa").Range("B6").Resize(x4 - 5, 21).Value
    End If
End Sub

 

قام بنشر

اشكرك استاذي على تفاعلك

 استاذي  صحيح الكود يلغي الطباعه ولكن
 

19 ساعات مضت, ahmedkamelelsayed0 said:

جرب هذا التعديل ربما يكون ما تريده

 Sub Macro01()

 

a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")

' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If a = vbYes Then
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        Exit Sub
        ElseIf Len(Numcop) > 0 Then
        End If
        a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")
If a = vbNo Then
 Exit Sub

 Else
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
 'اذ اخترت لا اريد الطباعة  عدد الصحيح الكود يقف ويلغي التنفيذ كذالك  هنا
 End If
End With
End If
    
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
 
End Sub

مازالت المشكلة قائمة 
حيث انه يتم الترحيل  الان (رغم الغاء الامر الاول من النافذة الاولى)
يفترض ان يخرج ويقف من تنفيذ الامر كله طباعه وترحيل

 

 

9 ساعات مضت, ali mohamed ali said:

تفضل اخى الكريم هذا كود الأستاذ الكبير ياسر خليل لعله يفى بالغرض


Sub Macro01()
    Dim x3          As Long
    Dim x4          As Long

    a = MsgBox("åá  ÊÑíÏ ØÈÇÚÉ ÇáÇä  ¿", vbYesNo + vbQuestion, "ØÈÇÚÉ")

    If a = vbYes Then
        With ActiveSheet
            Dim Numcop As Integer
            Numcop = Application.InputBox("ÃÏÎá ÚÏÏ ÇáäÓÎ ááØÈÇÚÉ:", "ßã ÚÏÏ ÇáäÓÎ?", 1, Type:=1)
            If Numcop = 0 Then
                Exit Sub
            ElseIf Len(Numcop) > 0 Then
                ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
                Exit Sub
            End If
        End With

Skipper:
        x3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
        x4 = Sheets("aaa").Range("B24").End(xlUp).Row
        Sheets("DATA").Range("B" & x3).Resize(x4 - 5, 21) = Sheets("aaa").Range("B6").Resize(x4 - 5, 21).Value
    End If
End Sub

 

قام بنشر

ممكن تجرب هذا التعديل لعله يكون المطلوب بالضبط

Sub Macro01()

 

a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")

' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If a = vbNo Then
 Exit Sub
End If
If a = vbYes Then
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        Exit Sub
        ElseIf Len(Numcop) > 0 Then
        End If
        a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")
If a = vbNo Then
 Exit Sub

 Else
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
 'اذ اخترت لا اريد الطباعة  عدد الصحيح الكود يقف ويلغي التنفيذ كذالك  هنا
 End If
End With
End If
    
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
 
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.

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

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

Important Information