wordden excele macro ile kopyalama

Katılım
15 Şubat 2008
Mesajlar
1
Excel Vers. ve Dili
office 2007-Beta-English ve office 2003 Türkçe
merhaba;
Macro yardımı ile word dosyasını otamatik açmak ve excel çalışma sayfasına otomatik kopyalamak istiyorum...
ES
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Merhabalar

Aşağıdaki kodu standart bir modül sayfasına kopyalayıp, bir butona atayınız.

Kod:
Sub Wordden_Al_Excele_Yapistir()
Dim wrd As Object
Dim doc As Object
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = False
     .Filters.Add "Word Belgeleri", "*.doc", 1
     If .Show = -1 Then
        Set wrd = CreateObject("Word.Application")
        wrd.Application.Visible = True
        Set doc = wrd.documents.Open(.SelectedItems(1))
        With doc.ActiveWindow.Selection
            .WholeStory
            .Copy
        End With
     End If
End With
Range("A1").Select
ActiveSheet.Paste
doc.Close 0
wrd.Quit
Set doc = Nothing
Set wrd = Nothing
End Sub
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
teşekkürler hocam faydalı olabilecek bir kod....
Ancak doc dosyası seçilmeden iptal ile çıkınca hata veriyor.
On error resume next ile engelelyebiliriz.. ama başka bir hata oluşursa onalrı kaçırız. Dosya seçilmemişse çık diyebilirmiyiz. sözün özü.
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Doğru söylüyorsunuz ben hiç dikkat etmemiştim. Atlamışım o kısmı ...

Dikkatiniz için teşekkürler...

Aşağıdaki gibi bir ilave ile bu hata giderilebilir.

Kod:
Sub Wordden_Al_Excele_Yapistir()
Dim wrd As Object
Dim doc As Object
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = False
     .Filters.Add "Word Belgeleri", "*.doc", 1
     If .Show = -1 Then
        Set wrd = CreateObject("Word.Application")
        wrd.Application.Visible = True
        Set doc = wrd.documents.Open(.SelectedItems(1))
        With doc.ActiveWindow.Selection
            .WholeStory
            .Copy
        End With
[COLOR=red]     Else
        Exit Sub
[/COLOR]     End If
End With
Range("A1").Select
ActiveSheet.Paste
doc.Close 0
wrd.Quit
Set doc = Nothing
Set wrd = Nothing
End Sub
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
teşekkürler hocam
 
Üst