Kapalı Word dosyalarında alt bilgi değişiklik yapma

[1903emre34@gmail.com]

Merhabalar,

Aşağıdaki kod aracılığıyla, Word dosyaların alt bilgi kısmında yer alan bilgileri değiştiyorum, ama tek seçenek sunuyor, bir den fazla seçenek sunması için kodlarda nasıl değişklik yapabiliriz?




Sub WD_Altbilgi()
eskibilgi = Application.InputBox("ESKİ BİLGİ veri girişi yapınız.", "eskibilgi", ActiveSheet.Range("f1").Value)
If eskibilgi = False Then Exit Sub
yenibilgi = Application.InputBox("YENİ BİLGİ için veri girişi yapınız.", "yenibilgi", ActiveSheet.Range("f2").Value)
If yenibilgi = False Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count > 0 Then
yol = .SelectedItems.Item(1)
Else
Exit Sub
End If
End With
dosya = Dir(yol & "\*.doc*")
Set WD = CreateObject("word.Application")
WD.Visible = True
Do While dosya <> ""
WD.Application.Documents.Open yol & "\" & dosya
WD.Selection.Find.ClearFormatting
WD.Selection.Find.Replacement.ClearFormatting
WD.ActiveWindow.ActivePane.View.SeekView = 10
WD.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = False
With WD.Selection.Find
.Text = eskibilgi
.Replacement.Text = yenibilgi
.Forward = True
.Wrap = 1
End With
WD.Selection.Find.Execute Replace:=2
WD.ActiveDocument.Close True

 

[PLİNT]

Merhaba
Ek dosyayı deneyin
http://s9.dosya.tc/server2/l3ssj7/deneme.zip.html
World dosyalarının bulunduğu klasörü seçtikten sonra "Inputbox" a gelen alt bilgi içinde değişiklik yapıp tamamı tıklayın.

[SIZE="2"]Private Sub CommandButton1_Click()
Dim s, y, ds, dc, W, j, dosya, M
Dim yol As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
 If .SelectedItems.Count > 0 Then
 yol = .SelectedItems.Item(1)
 Else
 Exit Sub
 End If
End With
Set s = CreateObject("Word.Application")
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(yol)
Set dc = f.Files
For Each dosya In dc
If ds.GetExtensionName(dosya.Name) Like "doc*" Then
Set y = s.Documents.Open(yol & "\" & dosya.Name)
s.Visible = True
y.PageSetup.DifferentFirstPageHeaderFooter = False
For Each j In y.Sections(1).Footers
M = Replace(j.Range.Text, Chr(13), "")
If M <> "" Then
bilgi = Application.InputBox("ESKİ BİLGİ ÜZERİNDE DEĞİŞİKLİK YAPINIZ.", "eskibilgi", M)
If bilgi = False Then Exit For
j.Range.Text = Replace(M, M, bilgi)
End If
Next
y.Close True
End If
Next
s.Quit
End Sub [/SIZE]