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

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

قام بنشر

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

لو سمحتوا عمالقه الاكسيل كنت محتاج مساعدتكم فى تعديل على الكود دا

اني اخليه يطبع الشيت مرتين ورا بعض

 

شكرا

Sub Macro1()
'
' Macro1 Macro
'
Dim countpersons  As Integer
Dim photofilepath As String
Dim MyPrintArea As String
Dim datafile As String
Dim Rw As Long
Dim xleft As Integer
'-----------------------------hr
countpersons = 3
'photofilepath = "y:\photo\turks\"      'turkish photo path
Rw = 2  'start row
datafile = "D:\Wael D\WAEL\New folder (5)\contarct\2018\Data 2018 Arabic"
 
MyPrintArea = "A1:C119 "
'---------------------------------------
    Dim wb As Workbook
    Dim W As Workbook
    Set W = ActiveWorkbook
   
   
    Dim wb2 As Workbook
    Set wb2 = ActiveWorkbook
   Workbooks.Open datafile
    Set wb2 = ActiveWorkbook
Dim I As Integer
Dim SourceSheet As Worksheet
I = 1
W.Sheets("Sheet1").Activate
 For I = 1 To countpersons
    With Sheets("Sheet1")
      .Range("A1").Value = ""
      .Range("B1").Value = ""
      .Range("B7").Value = ""
      .Range("B9").Value = ""
      .Range("B10").Value = ""
      .Range("B11").Value = ""
      .Range("B12").Value = ""
      .Range("B13").Value = ""
      .Range("B14").Value = ""
      .Range("B25").Value = ""
      .Range("B29").Value = ""
      .Range("B30").Value = ""
        '.Range("B23").Value = ""
        '.Range("B24").Value = ""
        '.Range("B26").Value = ""
        '.Range("B27").Value = ""
        '.Range("B29").Value = ""
        '.Range("B30").Value = ""
       
       
   
   
   '  If Sheets("Sheet2").Range("C" & Rw).Value <> "" Then
 
   
        .Range("A1").Value = wb2.Worksheets("Sheet1").Range("A" & Rw).Value
        .Range("B1").Value = wb2.Worksheets("Sheet1").Range("D" & Rw).Value
        .Range("B7").Value = wb2.Worksheets("Sheet1").Range("G" & Rw).Value
        .Range("B9").Value = wb2.Worksheets("Sheet1").Range("H" & Rw).Value
        .Range("B10").Value = wb2.Worksheets("Sheet1").Range("K" & Rw).Value
        .Range("B11").Value = wb2.Worksheets("Sheet1").Range("L" & Rw).Value
        .Range("B12").Value = wb2.Worksheets("Sheet1").Range("M" & Rw).Value
        .Range("B13").Value = wb2.Worksheets("Sheet1").Range("N" & Rw).Value
        .Range("B14").Value = wb2.Worksheets("Sheet1").Range("I" & Rw).Value
        .Range("B25").Value = wb2.Worksheets("Sheet1").Range("J" & Rw).Value
        .Range("B29").Value = wb2.Worksheets("Sheet1").Range("O" & Rw).Value
        .Range("B30").Value = wb2.Worksheets("Sheet1").Range("P" & Rw).Value
        '.Range("B21").Value = wb2.Worksheets("Sheet1").Range("M" & Rw).Value
       ' .Range("B23").Value = wb2.Worksheets("Sheet1").Range("N" & Rw).Value
       ' .Range("B24").Value = wb2.Worksheets("Sheet1").Range("P" & Rw).Value
        '.Range("B26").Value = wb2.Worksheets("Sheet1").Range("Q" & Rw).Value
        '.Range("B27").Value = wb2.Worksheets("Sheet1").Range("S" & Rw).Value
        '.Range("B29").Value = wb2.Worksheets("Sheet1").Range("T" & Rw).Value
        '.Range("B30").Value = wb2.Worksheets("Sheet1").Range("V" & Rw).Value
  
 
 
        With Sheets("Sheet1").PageSetup
       '.PaperSize =
       .PrintArea = MyPrintArea
        End With
        With ActiveWorkbook
         .Worksheets("Sheet1").PrintOut
         End With
    
      End With
    Rw = Rw + 1
  
Next
 
 
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