TURKOLOG
Altın Üye
- Katılım
- 13 Kasım 2008
- Mesajlar
- 744
- Excel Vers. ve Dili
- 2016 64 TR
- Altın Üyelik Bitiş Tarihi
- 29-10-2026
Herkese merhaba
Aşağıdaki kod ile seçilen sayfayı seçtiğim konuma kaydedebiliyorum ama 95 97 formatında kaydettiği için uyumluluk şeklinde kaydediyor ve ekteki mesajı veriyor sürekli .
Acaba dosyayı ofis 2016 ve üstü formatta kaydetmesi için kodu revize edebilecek var mı acaba
Aşağıdaki kod ile seçilen sayfayı seçtiğim konuma kaydedebiliyorum ama 95 97 formatında kaydettiği için uyumluluk şeklinde kaydediyor ve ekteki mesajı veriyor sürekli .
Acaba dosyayı ofis 2016 ve üstü formatta kaydetmesi için kodu revize edebilecek var mı acaba
Kod:
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Me.ListBox1.Clear
For Each ws In ActiveWorkbook.Worksheets
Me.ListBox1.AddItem ws.Name
Next ws
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim txtmsg As String, txttitle As String
Dim txtresult As String, txtdefault As String
Dim JJ As String
JJ = Application.GetSaveAsFilename("My Sheets", "Microsoft Excel Workbook (*.xls), *.xlsm", , "YILDIZ")
If JJ = "False" Then GoTo LastLine
'
Dim i As Integer, n() As String, f As Integer
Dim cnt1 As Integer, cnt2 As Integer
cnt1 = 0
For f = 0 To Me.ListBox1.ListCount
On Error GoTo 1
If Me.ListBox1.Selected(f) Then _
cnt1 = cnt1 + 1
1: Next f
ReDim n(1 To cnt1)
cnt2 = 0
For i = 0 To (Me.ListBox1.ListCount - 1)
On Error Resume Next
If Me.ListBox1.Selected(i) Then
cnt2 = cnt2 + 1
n(cnt2) = Me.ListBox1.list(i)
End If
Next i
On Error GoTo 0
Sheets(n).Copy
Sheets(n).Select
ActiveWorkbook.SaveAs Filename:= _
(JJ), _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
LastLine:
Application.ScreenUpdating = True
Unload Me
End Sub
