KLASÖRE RESİM KAYDETME VE RESMİ YENİDEN ADLANDIRMA

[musaliha]

Merhaba Sayfamda bir buton ile açılan pencereden bilgisayardaki resim dosyamı seçmek,önce seçtiğim dosyanın adını değişmek,sonrada form sayfamın bağlı olduğu exel dosyasının konumuna jpg uzantısıyla kaydetmek istiyorum.

bununla ilgili ulaştığım kaynaklardan aşağıdaki kodlarla bilgisayardan resim seçebiliyorum.istediğim konumada kaydedebiliyorum.fakat kaydetmeden önce adını değişmek istiyorum.yani bu kodun ekine hangi kod yazılmalı ki o kopyaladığım resim dosyasının adını değiştirebileyim.

Sub Kopyalama()
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Dosya Seçiniz"
If .show = True Then
Dosya = .SelectedItems(1)
End If
End With

fso.CopyFile Dosya, ThisWorkbook.Path & "\21-22\"
End Sub

 

[Hakan ERDOST]

Sub Kopyalama()
    Dim fso As Object
    Dim Dosya As String
    Dim YeniAd As String
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    
    ' Dosya seçimi
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Dosya Seçiniz"
        If .Show = True Then
            Dosya = .SelectedItems(1)
        End If
    End With
    
    ' Yeni dosya adı belirleme
    YeniAd = InputBox("Yeni dosya adını girin (uzantı hariç):", "Dosya Adı Değiştir")
    
    ' Dosya ismini değiştirme ve kopyalama
    If YeniAd <> "" Then
        ' Dosyanın adını değiştirme
        fso.CopyFile Dosya, ThisWorkbook.Path & "\21-22\" & YeniAd & ".jpg"
    Else
        MsgBox "Geçersiz dosya adı."
    End If
End Sub

Deneyiniz.

 

[musaliha]

Teşekkür ederim .Tam istediğim gibi sağolun.harikasınız

 

[Hakan ERDOST]

Teşekkür ederim .Tam istediğim gibi sağolun.harikasınız

Rica ederim.Kolay gelsin.

 

[muratgunay48]

Sub Kopyalama()
    Dim fso As Object
    Dim Dosya As String
    Dim YeniAd As String
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
   
    ' Dosya seçimi
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Dosya Seçiniz"
        If .Show = True Then
            Dosya = .SelectedItems(1)
        End If
    End With
   
    ' Yeni dosya adı belirleme
    YeniAd = InputBox("Yeni dosya adını girin (uzantı hariç):", "Dosya Adı Değiştir")
   
    ' Dosya ismini değiştirme ve kopyalama
    If YeniAd <> "" Then
        ' Dosyanın adını değiştirme
        fso.CopyFile Dosya, ThisWorkbook.Path & "\21-22\" & YeniAd & ".jpg"
    Else
        MsgBox "Geçersiz dosya adı."
    End If
End Sub

Deneyiniz.

Hocam emeğinize sağlık. Hocam özellikle resimlerle ilgili dosyalar benim ilgimi çekiyor da.
Burada 21-22 yazan yere resmin kaydedileceği dosya yolu yazılacak değil mi. Bu sefer modüle
Yani benim klasörüm için
fso.CopyFile Dosya, ThisWorkbook.Path & "\C:\Users\muratgunay48\Desktop\test\" & YeniAd & ".jpg"
Bu şekilde bu satırda hata veriyor.

 

[Hakan ERDOST]

fso.CopyFile Dosya, ThisWorkbook.Path & "\test\" & YeniAd & ".jpg"

Bu şekilde deneyin.Ancak resimlerin bulunduğu klasörün Excel Çalışma kitabı ile aynı dizinde/klasörde olmalı.

 

[muratgunay48]

fso.CopyFile Dosya, ThisWorkbook.Path & "\test\" & YeniAd & ".jpg"

Bu şekilde deneyin.Ancak resimlerin bulunduğu klasörün Excel Çalışma kitabı ile aynı dizinde/klasörde olmalı.

Hocam çok teşekkür ederim. Bu şekilde çalıştı. Var olun.