Soru Dolu hücreleri büyük veya küçük harf yapma ve seçilen şablonun bulunduğu klasörün içine kaydetme

[lion_25_77]

Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
dosya = Application.GetOpenFilename("Lütfen Dosyayı Seçiniz (*.docx),*.docx;")
If dosya <> "False" Then
MsgBox "Dosya Seçildi."
Else
MsgBox "Dosyayı Seçmediniz!"
End If
For Each x In Range("AU2:AU1048576")
x.Value = UCase(Replace(Replace(x.Value, "i", "İ"), "ı", "I"))
Next
For i = 2 To Range("A1048576").End(xlUp).Row 'eğer bir kaç sayfa varsa hangi sayfada ise parantez içine sayfanın nosu girilerek yazılır. Örnek For i = 2 To sheets("sayfa1").Range("A1048576").End(xlUp).Row
Set doc = wordapp.Documents.Open(dosya)
doc.SaveAs2 "C:\Users\lion\Desktop\Yazılım\" & Cells(i, 1) .Text
Next i
wordapp.Quit
End Sub


Arkadaşlar merhaba; yukarıda kodla bir çalışma yaptım. Bu kodla alakalı aşağıda belirttiğim hususlarda yardımcı olurmusunuz lütfen.

1 - Aşağıdaki kodu tüm sütuna değilde sadece dolu hücrelere uygulaması için nasıl değişiklik yapmamız gerekir.

For Each x In Range("AU2:AU1048576")
x.Value = UCase(Replace(Replace(x.Value, "i", "İ"), "ı", "I"))
Next

2- Bu kodla

dosya = Application.GetOpenFilename("Lütfen Dosyayı Seçiniz (*.docx),*.docx;")
If dosya <> "False" Then
MsgBox "Dosya Seçildi."
Else
MsgBox "Dosyayı Seçmediniz!"
End If

şablon olan dosya adlı değişkeni seçiyoruz ve işlem ona göre yapılıyor. Bu kodlada;

doc.SaveAs2 "C:\Users\lion\Desktop\Yazılım\" & Cells(i, 1) .Text

yapılan işlemi C:\Users\lion\Desktop\Yazılım\ adlı klasörün içine kaydediyoruz.

Aşağıdaki kodda nasıl bir değişiklik yaparsak dosya adlı değişkenli şablonun dosyasının bulunduğu klasörün içine kaydeder

doc.SaveAs2 "C:\Users\lion\Desktop\Yazılım\" & Cells(i, 1) .Text


Şimdiden çok teşekkür eder yardımlarınızı bekleriz

 

[Levent Menteşoğlu]

1. sorunuz için aşağıdaki gibi deneyin.

For Each x In Range("AU2:AU1048576").SpecialCells(xlCellTypeConstants, 23)
x.Value = UCase(Replace(Replace(x.Value, "i", "İ"), "ı", "I"))
Next

2. sorunuzda anladığım kadarıyla klasörü seçtirmek istiyorsunuz. Sadece klasör seçimi için aşağıdaki gibi deneyin.

Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
klasoryolu = klasor.Items.Item.Path
If klasoryolu = "" Then Exit Sub
doc.SaveAs2 klasoryolu & "\" & Cells(i, 1) .Text

Eğer dosyayı seçtiğinizde dosyanın bulunduğu klasör yolunu bulmak istiyorsanız aşağıdaki gibi deneyin.

dosya = Application.GetOpenFilename("Lütfen Dosyayı Seçiniz (*.docx),*.docx;")

If dosya <> False Then
MsgBox "Dosya Seçildi."
Else
MsgBox "Dosyayı Seçmediniz!"
End If

uz = Len(dosya) - Len(Replace(dosya, "\", ""))
For a = 1 To Len(dosya)
If Mid(dosya, a, 1) = "\" Then c = c + 1
If c = uz Then
klasor = Left(dosya, a)
Exit For
End If
Next

doc.SaveAs2 klasor & Cells(i, 1).Text

 

[lion_25_77]

1. sorunuz için aşağıdaki gibi deneyin.

For Each x In Range("AU2:AU1048576").SpecialCells(xlCellTypeConstants, 23)
x.Value = UCase(Replace(Replace(x.Value, "i", "İ"), "ı", "I"))
Next

2. sorunuzda anladığım kadarıyla klasörü seçtirmek istiyorsunuz. Sadece klasör seçimi için aşağıdaki gibi deneyin.

Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
klasoryolu = klasor.Items.Item.Path
If klasoryolu = "" Then Exit Sub
doc.SaveAs2 klasoryolu & "\" & Cells(i, 1) .Text

Eğer dosyayı seçtiğinizde dosyanın bulunduğu klasör yolunu bulmak istiyorsanız aşağıdaki gibi deneyin.

dosya = Application.GetOpenFilename("Lütfen Dosyayı Seçiniz (*.docx),*.docx;")

If dosya <> False Then
MsgBox "Dosya Seçildi."
Else
MsgBox "Dosyayı Seçmediniz!"
End If

uz = Len(dosya) - Len(Replace(dosya, "\", ""))
For a = 1 To Len(dosya)
If Mid(dosya, a, 1) = "\" Then c = c + 1
If c = uz Then
klasor = Left(dosya, a)
Exit For
End If
Next

doc.SaveAs2 klasor & Cells(i, 1).Text

Cevabınız için teşekkür ederim.