Soru Kapalı dosya sayfa sıralama

[schlecht]

Ekteki dosyadaki sayfaları

A_Menu.01.02
A_Menu.01.03
B_Menu.01.04
B_Menu.01.05
B_Menu.01.06
B_Menu.01.07
A_Menu.01.08

olacak şekilde sıralamak istiyorum. Forumdaki ve netteki örnekler hep açık dosya içine yazılan kodlar. Bu dosya kapalı olacak şeklde sıralama yapmak istiyorum.

Teşekkürler.

 

[NBATMAN]

Merhaba Ekte,
sizin konunuz ile ilgili Vb.net de bir program yazdım. Deneyebilir misiniz?

Ayrıca VB.net için kodlar aşağıdaki şekildedir. Belki buradan bir şeyler çıkarabilirsiniz.

    Public Sub EXCEL_SAYFA_SIRALAMA()
     
            Dim xlApp As Excel.Application
            Dim xlWorkBook As Excel.Workbook

            Dim i As Integer
            Dim j As Integer

            xlApp = New Excel.Application
            xlWorkBook = xlApp.Workbooks.Open(dosya)
            xlApp.Visible = False

            For i = 1 To xlWorkBook.Worksheets.Count
                For j = 1 To xlWorkBook.Worksheets.Count - 1
                    If UCase$(xlWorkBook.Worksheets(j).Name) > UCase$(xlWorkBook.Worksheets(j + 1).Name) Then
                        xlWorkBook.Worksheets(j).Move(After:=xlWorkBook.Worksheets(j + 1))
                    End If
                Next
            Next
            MessageBox.Show("Sıralama İşlemi Tamamlanmıştır.", "Bildirim", MessageBoxButtons.OK, MessageBoxIcon.Information)

       

            xlApp.DisplayAlerts = False
            xlWorkBook.Save()
            xlWorkBook.Close()
            xlApp.Quit()
            xlApp.UserControl = True




   
    End Sub

 

[schlecht]

Sayın program çok güzel çalışıyor. İlginize teşekkür ederim. Bu işlem için exe çalıştırmam pek mümkün değil. Kodlardan bir şeyler çıkartmaya çalışacağım.

 

[schlecht]

Malesef kodlardan uyarlayamadım.

 

[Muzaffer Ali]

Kodları düzenledim, Excel dosyanızda kullanabilirsiniz.

 Public Sub EXCEL_SAYFA_SIRALAMA(Dosya As String)
    Dim i As Integer, j As Integer
    Dim xlWorkBook As Workbook
    Set xlWorkBook = Workbooks.Open(Dosya)
    For i = 1 To xlWorkBook.Worksheets.Count
        For j = 1 To xlWorkBook.Worksheets.Count - 1
            If UCase$(xlWorkBook.Worksheets(j).Name) > UCase$(xlWorkBook.Worksheets(j + 1).Name) Then
                xlWorkBook.Worksheets(j).Move After:=xlWorkBook.Worksheets(j + 1)
            End If
        Next
    Next
    Application.DisplayAlerts = False
    xlWorkBook.Save
    xlWorkBook.Close
    Application.DisplayAlerts = True
    MsgBox "Sıralama İşlemi Tamamlanmıştır.", vbInformation
    
End Sub

Sub SayfaSirala()
    EXCEL_SAYFA_SIRALAMA "c:\Test.xlsx"
End Sub

 

[schlecht]

Kodları düzenledim, Excel dosyanızda kullanabilirsiniz.

 Public Sub EXCEL_SAYFA_SIRALAMA(Dosya As String)
    Dim i As Integer, j As Integer
    Dim xlWorkBook As Workbook
    Set xlWorkBook = Workbooks.Open(Dosya)
    For i = 1 To xlWorkBook.Worksheets.Count
        For j = 1 To xlWorkBook.Worksheets.Count - 1
            If UCase$(xlWorkBook.Worksheets(j).Name) > UCase$(xlWorkBook.Worksheets(j + 1).Name) Then
                xlWorkBook.Worksheets(j).Move After:=xlWorkBook.Worksheets(j + 1)
            End If
        Next
    Next
    Application.DisplayAlerts = False
    xlWorkBook.Save
    xlWorkBook.Close
    Application.DisplayAlerts = True
    MsgBox "Sıralama İşlemi Tamamlanmıştır.", vbInformation
   
End Sub

Sub SayfaSirala()
    EXCEL_SAYFA_SIRALAMA "c:\Test.xlsx"
End Sub

Set xlWorkBook = Workbooks.Open(Dosya)
bu satırda hata verdi dosya yolu belirtmen mi gerekiyor? Dosyayı seçmem gerekior . Sabit bir dosya yolu yok çünkü.

 

[schlecht]

Sub EXCEL_SAYFA_SIRALAMA()
Dim i As Integer, j As Integer
Dim xlWorkBook As Workbook
Dosya = Application.GetOpenFilename(filefilter:="Excel dosyaları,*.xls;*.xlsx;*.xlsm", Title:="Dosya Seçiniz.")
Set xlWorkBook = Workbooks.Open(Dosya)
For i = 1 To xlWorkBook.Worksheets.Count
For j = 1 To xlWorkBook.Worksheets.Count - 1
If UCase$(xlWorkBook.Worksheets(j).Name) > UCase$(xlWorkBook.Worksheets(j + 1).Name) Then
xlWorkBook.Worksheets(j).Move After:=xlWorkBook.Worksheets(j + 1)
End If
Next
Next
Application.DisplayAlerts = False
xlWorkBook.Save
xlWorkBook.Close
Application.DisplayAlerts = True
MsgBox "Sıralama İşlemi Tamamlanmıştır.", vbInformation

End Sub


bu halde a'dan z' ye sıralıyor. İstediğim gibi sıralama yapmadı. Nerde hata yapmış olabilirim?

 

[PLİNT]

Merhaba
Yukarıdaki kodları:

Sayfa adlarındaki "Menu." ifadesinden sonrasına göre sıralamak için;

Sub EXCEL_SAYFA_SIRALAMA()
Dim i As Integer, j As Integer
Dim xlWorkBook As Workbook
Dosya = Application.GetOpenFilename(filefilter:="Excel dosyaları,*.xls;*.xlsx;*.xlsm", Title:="Dosya Seçiniz.")
Set xlWorkBook = Workbooks.Open(Dosya)
For i = 1 To xlWorkBook.Worksheets.Count
For j = 1 To xlWorkBook.Worksheets.Count - 1
If UBound(Split(xlWorkBook.Worksheets(j).Name, "Menu.")) <> 0 Then
If UCase$(Split(xlWorkBook.Worksheets(j).Name, "Menu.")(1)) > UCase$(Split(xlWorkBook.Worksheets(j + 1).Name, "Menu.")(1)) Then
xlWorkBook.Worksheets(j).Move After:=xlWorkBook.Worksheets(j + 1)
End If: End If
Next
Next
Application.DisplayAlerts = False
xlWorkBook.Save
xlWorkBook.Close
Application.DisplayAlerts = True
MsgBox "Sıralama İşlemi Tamamlanmıştır.", vbInformation

End Sub

Sayfa adlarının son 5 karekterine göre sıralamak içinde şöyle kullanabilirsiniz

Sub EXCEL_SAYFA_SIRALAMA()
Dim i As Integer, j As Integer
Dim xlWorkBook As Workbook
Dosya = Application.GetOpenFilename(filefilter:="Excel dosyaları,*.xls;*.xlsx;*.xlsm", Title:="Dosya Seçiniz.")
Set xlWorkBook = Workbooks.Open(Dosya)
For i = 1 To xlWorkBook.Worksheets.Count
For j = 1 To xlWorkBook.Worksheets.Count - 1
If Len(xlWorkBook.Worksheets(j).Name) > 4 Then
If UCase$(Trim(Right(xlWorkBook.Worksheets(j).Name, 5))) > UCase$(Trim(Right(xlWorkBook.Worksheets(j + 1).Name, 5))) Then
xlWorkBook.Worksheets(j).Move After:=xlWorkBook.Worksheets(j + 1)
End If: End If
Next
Next
Application.DisplayAlerts = False
xlWorkBook.Save
xlWorkBook.Close
Application.DisplayAlerts = True
MsgBox "Sıralama İşlemi Tamamlanmıştır.", vbInformation

End Sub

 

[schlecht]

Sayın PLİNT teşekkürler. İstenilen şekilde sıralama yaptı. Elinize sağlık.