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

انشاء كود ترحيل وكود طباعة


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

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

ملفي اليوم شارف على الانتهاء ولكن بقي لي موضوعين لم افلح بهم

ترحيل وطباعة . قمت باختصار الملف الى مايهمني

الرجاء المساعدة  ... عنوان مخالف ... تــــم تعديل عنوان المشاركة ليعبر عن طلبك

للانترنت.xlsm

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

اخي نثغةثمسخبف   :  شرح غير واضح

يورجي التوضيح

المدي المراد ترحيلة

هل هي خليه متفرقة 

ام تريد الترحيل من a3:x15

والي اي شيت تريد الترحيل

جزاك الله خيراَ

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

الاخ محمد يوسف

شكرا على تفاعلك معي

الملف لايفي بالغرض

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

بينما المطلوب ترحيل اعمدة وخلايا متفرقة الى اعمدة وخلايا متفرقة اخرى

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

مع جزيل الشكر

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

السلام عليكم ورحمة الله وبركاته وبها نبدأ 

تفضل اخى 

Sub Transfer_Non_Adjacent_Columns()
    Dim WS As Worksheet, SH As Worksheet
    Dim LR As Long
    Set SH = ThisWorkbook.Worksheets("صفحة العمل")
    Set WS = ThisWorkbook.Worksheets("ترحيل الشراء")
    LR = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With WS.Cells(LR, "A").Resize(4, 1)
        .Value = SH.Range("A12").Value
        .Offset(0, 2).Value = SH.Range("B11:B15").Value
        .Offset(0, 3) = SH.Range("J3:J7").Value
        .Offset(0, 4) = SH.Range("D3:D7").Value
        .Offset(0, 5) = SH.Range("I3:I7").Value
        .Offset(0, 6) = SH.Range("E11:E15").Value
        .Offset(0, 7) = SH.Range("F11").Value
        SH.Range("A12").Value = SH.Range("A12").Value + 1
    End With

 

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

اخي محمد

قمت بالسهر ليلة امبارحة

افحص الكود الذي قمت بكتابته

لايسعني الا ان اقول انه رائع وقمت بتعديله حسب خبرتي المتواضعة ونجحت بذلك

تعديل Lr من a الى c ليكون بداية الترحيل الى اخر سطر بالعمود c

وتعديل رقم العمود الذي وضعته رقما 13 الى i3

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

والطباعة ؟؟؟؟ مع جزيل الشكر

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

اخي   نثغةثمسخبف

الكود بعد اضافة الطباعه والمسج اصبح هكذا

sub SAVE()
Dim Ws As Worksheet: Set Ws = Sheets("صفحة العمل")
Dim Sh As Worksheet: Set Sh = Sheets("ترحيل الشراء")

LR = Sh.Range("a" & Rows.Count).End(xlUp).Row
Sh.Range("a" & LR + 1) = Ws.Range("a2")
Sh.Range("a" & LR + 1).Offset(0, 0) = Ws.Range("a12")

Sh.Range("a" & LR + 1).Offset(0, 2) = Ws.Range("b11")
Sh.Range("a" & LR + 1).Offset(1, 2) = Ws.Range("b12")
Sh.Range("a" & LR + 1).Offset(2, 2) = Ws.Range("b13")
Sh.Range("a" & LR + 1).Offset(3, 2) = Ws.Range("b14")
Sh.Range("a" & LR + 1).Offset(4, 2) = Ws.Range("b15")


Sh.Range("a" & LR + 1).Offset(0, 3) = Ws.Range("J3")
Sh.Range("a" & LR + 1).Offset(1, 3) = Ws.Range("J4")
Sh.Range("a" & LR + 1).Offset(2, 3) = Ws.Range("J5")
Sh.Range("a" & LR + 1).Offset(3, 3) = Ws.Range("J6")
Sh.Range("a" & LR + 1).Offset(4, 3) = Ws.Range("J7")
'
Sh.Range("a" & LR + 1).Offset(0, 4) = Ws.Range("D3")
Sh.Range("a" & LR + 1).Offset(1, 4) = Ws.Range("D4")
Sh.Range("a" & LR + 1).Offset(2, 4) = Ws.Range("D5")
Sh.Range("a" & LR + 1).Offset(3, 4) = Ws.Range("D6")
Sh.Range("a" & LR + 1).Offset(4, 4) = Ws.Range("D7")
'
Sh.Range("a" & LR + 1).Offset(0, 5) = Ws.Range("l3")
Sh.Range("a" & LR + 1).Offset(1, 5) = Ws.Range("l4")
Sh.Range("a" & LR + 1).Offset(2, 5) = Ws.Range("l5")
Sh.Range("a" & LR + 1).Offset(3, 5) = Ws.Range("l6")
Sh.Range("a" & LR + 1).Offset(4, 5) = Ws.Range("l3")
'
Sh.Range("a" & LR + 1).Offset(0, 6) = Ws.Range("e11")
Sh.Range("a" & LR + 1).Offset(1, 6) = Ws.Range("e12")
Sh.Range("a" & LR + 1).Offset(2, 6) = Ws.Range("e13")
Sh.Range("a" & LR + 1).Offset(3, 6) = Ws.Range("e14")
Sh.Range("a" & LR + 1).Offset(4, 6) = Ws.Range("e15")

Sh.Range("a" & LR + 1).Offset(0, 7) = Ws.Range("l3")
Sh.Range("a" & LR + 1).Offset(1, 7) = Ws.Range("l4")
Sh.Range("a" & LR + 1).Offset(2, 7) = Ws.Range("l5")
Sh.Range("a" & LR + 1).Offset(3, 7) = Ws.Range("l6")
Sh.Range("a" & LR + 1).Offset(4, 7) = Ws.Range("l7")
Sh.Range("a" & LR + 0).Offset(1, 7) = Ws.Range("f11")
[a12] = [a12] + 1
Sh.Activate
Sheets(1).Activate
    Reply = MsgBox("                            تم الترحيل بنجاح" & Chr(10) & " هل تريد'طباعة الفاتورة       ", vbYesNo) 'هنا هل تريد طبع النسخ ام لا
     If Reply <> 6 Then Exit Sub 'هنا هل تريد طبع النسخ ام لا

'          ActiveWindow.SelectedSheets.PrintPreview 'معاينة قبل الطباعة '
'         Application.Dialogs(xlDialogPrinterSetup).Show  '''هذا خاص باختيار الطباعه

  Application.ScreenUpdating = False
  With Sheets("صفحة العمل") 'هنا حدد الشيت المراد طباعتة'
    With .UsedRange
      For i = 1 To .Rows.Count
         If .Cells(i, 1).Value = "" Then
           .Cells(i, 1).EntireRow.Hidden = True   '-c معتمد علي العمود  'هذا الستر الذي يمنع الفراغ
         End If
        Next i
      End With
      .PrintOut
     Rows.Hidden = False
  End With
  Application.ScreenUpdating = True
end sub

تفضل  مثال 3.xlsm

اخبرني بالنتيجه 

 

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

اخي محمد

ربما لم اوفق ان اوصل لك فكرتي

لغاية الترحيل وظهور نافذة تم الترحيل هل تريد الطباعة . نعم كل شيئ رائع تسلم هالايادي

ولكن صفحة طباعة الشراء . هي عبارة عن شيت تكون فيه معلومات الخلية هي نفسها معلومات مختارة من شيت صفحة العمل بمعادلة ()=

امر الطباعة هي للسطور التي يكون فيها خلايا العمود B من شيت الطباعة لاتساوي 0

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

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

مع جزيل الشكر

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

اخ محمد

جزاك الله عني كل خير

الكود رائع جدا وهو المطلوب

ولكن اظن انه لايمكن تحقيق المراد بسبب وجود خلايا مدمجة بشيت طباعة الشراء

سأوضح لك

المجال B1:J10 هو ثابت يظهر بالطباعة دائما

المجال من B21:J26 ايضا ثابت يظهر بالطباعة دائما

نأتي الى المجال B11:J20 تأتي المعضلة

المطلوب

كل خلية ( مدمجة ) من العمود B تساوي الصفر

يصبح المجال للسطرين مهمل بالطباعة

مثال ليكن الخلية B19 تساوي الصفر

يصبح المجال من B19:J20 لايظهر بالطباعة

ايضا الخلية B15 تساوي 0 يصبح المجال B15:J16 مهمل بالطباعة

ايضا الخلية B13 اكبر من 0 يصبح المجال B13:J14 يظهر بالطباعة

اعتقد انني قد وفقت بالشرح

والف شكر على تجاوبك معي

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

اخي محمد

ربما خطأي هو بالخلية المدمجة . تم تعديل شيت الطباعة وجعلهم كلهم بصف واحد

وتطبيق المعادلة والكود

وقد تم الامر

شكرا جزيلا وجعل تعبك معي ومع المشفى في صحيفة اعمالك

  • 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