اذهب الي المحتوي
أوفيسنا

تعديل فى كود


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

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

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

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

 

شكرا

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