Excel 2010 Pdf Macro, 2013 de Çalışmıyor

[ofd2008]

Merhaba,

Excel 2010 da seçili alanların pdf'ye aktarılması çalışıyor. Ancak Excel 2013 de macro çalışmadı ve herhangi bir uyarıda vermedi. Nasıl çözebilirim?

Saygılarımla


Kodlama:

Sub pdfaktar()
On Error Resume Next
With Application
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
 .EnableEvents = False
End With
yer = ActiveSheet.Name
sut = "f"

Set s1 = Sheets(yer)
For t = 40 To s1.Cells(Rows.Count, sut).End(3).Row
s1.Cells(t, "e") = ""
Next t


Dim Picture As Object

For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
If s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOn Then
Say1 = Picture.BottomRightCell.Row
s1.Cells(Say1, "e") = "Evet"
End If
End If
Next Picture



say3 = ActiveWorkbook.Sheets.Count
ReDim deg1(say3)
ReDim sayfa(50)

For j = 1 To say3
deg1(j) = Sheets(j).Name
Sheets(Sheets(j).Name).ResetAllPageBreaks
Sheets(Sheets(j).Name).PageSetup.PrintArea = ""
Next



say2 = 0

    For r = 40 To s1.Cells(Rows.Count, sut).End(3).Row
    aranan3 = s1.Cells(r, sut)
    Say4 = 0
    deg2 = ""
    
    If WorksheetFunction.CountIf(s1.Range("f40:f" & r), aranan3) = 1 Then
    
              For i = r To s1.Cells(Rows.Count, sut).End(3).Row
              If s1.Cells(i, "e") = "Evet" And aranan3 = s1.Cells(i, sut) Then
              Say4 = Say4 + 1
              
              If Say4 = 1 Then
              deg2 = s1.Cells(i, "g")
              Else
              deg2 = deg2 & "," & s1.Cells(i, "g")
              End If
            
              End If
              Next i
        
        If deg2 <> "" Then
            If IsNumeric(aranan3) = True Then aranan3 = "" & aranan3 & ""
            Sheets(aranan3).View = xlPageBreakPreview ' sayfa sonu ön izleme
            Sheets(aranan3).PageSetup.PrintArea = deg2
            Sheets(aranan3).PageSetup.CenterHorizontally = True
            Sheets(aranan3).PageSetup.Zoom = False
            Sheets(aranan3).PageSetup.FitToPagesWide = 1
            Sheets(aranan3).PageSetup.FitToPagesTall = False
            Sheets(aranan3).PageSetup.BlackAndWhite = 1
            If Sheets("Bilgi").Range("A1").Value = "HK" Then
            Sheets(aranan3).PageSetup.LeftHeader = "Proje Adı:" & Sheets("Bilgi").Range("D3").Value & Chr(10) & "Hazırlayan:" & "Proje"
            Sheets(aranan3).PageSetup.RightHeader = "&D" & Chr(10) & "&T"
            Else
            Sheets(aranan3).PageSetup.LeftHeader = "Proje Adı:" & Sheets("Bilgi").Range("D3").Value & Chr(10) & "Hazırlayan:" & "Etüd Proje"
            Sheets(aranan3).PageSetup.RightHeader = "&D" & Chr(10) & "&T"
            End If
            Sheets(aranan3).PageSetup.RightFooter = String(100, "_") & vbLf & "Sayfa &P / &N"
            Sheets(aranan3).PageSetup.LeftFooter = String(100, "_") & vbLf & "v2.15"
            say2 = say2 + 1
            sayfa(say2) = aranan3
            
            If UBound(Split(deg2, ",")) <= 0 Then
            Sheets(aranan3).VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
            Sheets(aranan3).HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1

            End If
            Sheets(aranan3).View = xlNormalView 'sayfa normal
        
        End If
    
    
    End If
    Next r



If say2 = 0 Then Exit Sub

Dim myArray() As Variant
m = 0
For i = 1 To say2
ReDim Preserve myArray(m)
myArray(m) = sayfa(i)
m = m + 1
Sheets(sayfa(i)).Move Before:=Sheets(m)
Next i

Sheets(myArray).Select

Dim Yol As String

Yol = ThisWorkbook.Path
Say5 = "Sistem Raporu"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & Say5 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True


For j = 1 To say3
Sheets(deg1(j)).Move Before:=Sheets(j)
Next

Sheets(yer).Select

With Application
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .EnableEvents = True
End With
MsgBox "Hesaplar Pdf Formatına Aktarıldı.", vbInformation, " BİLGİ "

End Sub