Alan Adında Karakter Öncesi Silen Makro

' Opline Alan Adından Karakter Öncesini Silme Makrosu (Ayar Kaydetme)
' Açıklama: Kullanıcıdan seçilen opline (alan) objelerinin pname özelliğinden, kullanıcı tarafından belirtilen bir karakterden (örn. /) önceki kısmı siler. Örneğin, pname = "101/1" ise, / karakterinden önceki 101 silinir ve pname = "1" olur. Ayraç karakteri C:\sabangul\NCMAKRO\AYAR\ayrac.txt dosyasına kaydedilir ve sonraki çalıştırmalarda buradan okunur.
' Yazar: Şaban Gül
' Tarih: 18 Mayıs 2025

Option Explicit

Sub Main
    Dim i, j, o, SEL, u, ayrac, fso, dosya, dosyaYolu
    Const AYAR_DIZINI = "C:\sabangul\NCMAKRO\AYAR"
    Const AYAR_DOSYASI = "ayrac.txt"
    dosyaYolu = AYAR_DIZINI & "\" & AYAR_DOSYASI

    With Netcad
        ' Dosya sistemi nesnesi oluştur
        Set fso = CreateObject("Scripting.FileSystemObject")

        ' Ayar dosyasını oku
        ayrac = "/"
        If fso.FileExists(dosyaYolu) Then
            Set dosya = fso.OpenTextFile(dosyaYolu, 1) ' 1 = okuma
            If Not dosya.AtEndOfStream Then
                ayrac = dosya.ReadLine
            End If
            dosya.Close
        End If

        ' Kullanıcıdan ayracı al (varsayılan: dosya veya /)
        ayrac = InputBox("Hangi karakterden öncesi silinsin? (örn. /)", "Karakter Seçimi", ayrac)
        If ayrac = "" Then Exit Sub ' Boş veya iptal edilirse çık

        ' Ayar dosyasını güncelle
        If Not fso.FolderExists(AYAR_DIZINI) Then
            fso.CreateFolder AYAR_DIZINI
        End If
        Set dosya = fso.CreateTextFile(dosyaYolu, True) ' True = üzerine yaz
        dosya.WriteLine ayrac
        dosya.Close

        Set SEL = .NewSelectionSet
        Set o = .NewObject
        If SEL.Select("Alan objelerini seçiniz", Array(opline)) Then
            For i = 0 To SEL.NE - 1
                j = SEL.GetSelectedObject(i, o)
                AdDuzelt o, ayrac
                .PutObject j, o
            Next
            SEL.RedrawAndRewind
            Set u = .GetCurrentWindow
            .SetCurrentWindow u, 1
        End If
        Set u = Nothing
        Set SEL = Nothing
        Set o = Nothing
        Set fso = Nothing
        Set dosya = Nothing
    End With
End Sub

Sub AdDuzelt(o, ayrac)
    If o.Tag = opline Then ' Sadece opline objeleri için çalış
        Dim pozisyon
        pozisyon = InStr(o.pname, ayrac)
        If pozisyon > 0 Then
            o.pname = Mid(o.pname, pozisyon + Len(ayrac))
        End If
    End If
End Sub