Word soru düzenleme

[halit3]

Kodu yeniden düzenledim.

@halit3 bey deneyip dönüş yapacağım. Çok teşekkür ederim.

Set objDialog = CreateObject("MSComDlg.CommonDialog")

burda hata veriyor. referansları ekledim.

Sub tablo_word12()
'referanslar
'Microsoft Word 12.0 Object Library

Dim objWord As Word.Application
Dim docWord As Word.Document

yol = Application.GetOpenFilename(FileFilter:="Word Files (*.doc*), *.doc*") ', Title:="Choose Files", MultiSelect:=True)

If yol = False Then
MsgBox "Dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If

Cells.ClearContents
Cells.Interior.ColorIndex = xlNone


Set objWord = CreateObject("Word.Application")
objWord.Visible = True

Set docWord = objWord.Documents.Open(Filename:=yol, ReadOnly:=True)
objWord.ActiveDocument.Application.WindowState = wdWindowStateMinimize

sat = 1

For s = 1 To objWord.ActiveDocument.Paragraphs.Count
sat = sat + 1
Cells(sat, 1) = Replace(Replace(objWord.ActiveDocument.Paragraphs(s).Range.Text, Chr(13), ""), "", "")
If Cells(sat, 1).Value <> "" Then
If objWord.ActiveDocument.Paragraphs(s).Range.HighlightColorIndex > 0 Then
Cells(sat, 1).Interior.ColorIndex = 3
End If
End If

Next s

docWord.Close False
objWord.Quit
Set docWord = Nothing

MsgBox "işlem tamam"

End Sub

 

[dEdE]

Sayın halit3
Yukardaki kodunuza aşağıdaki satırı entegre edebilir miyiz? Excele aktarırken otomatik numaraları da statik texte dönüştürerek almak istiyorum.
Bu satırı sizin kodunuza entegre edemedim.
objWord.ActiveDocument.Range.ListFormat.ConvertNumbersToText

 

[tukayf]

Hocam yarın sabah deneyebilirim. Şu an PC ye erişme durumum yok. Çok teşekkür ederim.

 

[halit3]

Sayın halit3
Yukardaki kodunuza aşağıdaki satırı entegre edebilir miyiz? Excele aktarırken otomatik numaraları da statik texte dönüştürerek almak istiyorum.
Bu satırı sizin kodunuza entegre edemedim.
objWord.ActiveDocument.Range.ListFormat.ConvertNumbersToText

Anladığım kadarı ile siz dosya açılınca istediğiniz düzenleme olsun ve kayıt etsin.
kod

Sub tablo_word13()
'referanslar
'Microsoft Word 12.0 Object Library

Dim objWord As Word.Application
Dim docWord As Word.Document

yol = Application.GetOpenFilename(FileFilter:="Word Files (*.doc*), *.doc*") ', Title:="Choose Files", MultiSelect:=True)

If yol = False Then
MsgBox "Dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If

Cells.ClearContents
Cells.Interior.ColorIndex = xlNone


Set objWord = CreateObject("Word.Application")
objWord.Visible = True

'Set docWord = objWord.Documents.Open(Filename:=yol, ReadOnly:=True)
Set docWord = objWord.Documents.Open(yol)
objWord.ActiveDocument.Range.ListFormat.ConvertNumbersToText

objWord.ActiveDocument.Application.WindowState = wdWindowStateMinimize

sat = 1
For s = 1 To objWord.ActiveDocument.Paragraphs.Count
sat = sat + 1
Cells(sat, 1) = Replace(Replace(objWord.ActiveDocument.Paragraphs(s).Range.Text, Chr(13), ""), "", "")
If Cells(sat, 1).Value <> "" Then
If objWord.ActiveDocument.Paragraphs(s).Range.HighlightColorIndex > 0 Then
Cells(sat, 1).Interior.ColorIndex = 3
End If
End If

Next s

docWord.Close SaveChanges:=wdSaveChanges

objWord.Quit
Set docWord = Nothing


MsgBox "işlem tamam"

End Sub

 

[tukayf]

Evet bu kod çalışıyor. Düzenlemeyi yapıyor. Sn. @halit3 gerisini nasıl çözebiliriz.