kapalı dosyaya veri göndermek

udentr2002 · 3 Mayıs 2012

Merhaba arkadaşlar,

Aşağıda ki kod ile kapalı dosyaya veri göndermeye çalışıyorum.

Ancak dosya ağda olduğu için başka bilgisayarlarda açık olabiliyor.
Bu yüzden aşağıda ki kodda nasıl bir değişiklik yapmalıyım ki veri göndermek istediğim dosya açıkda olsa kapalıda olsa veriyi göndersin.

Kod:

Set Belgem = CreateObject("Excel.Application")
Belgem.Workbooks.Open (ThisWorkbook.Path & "\CoA&MSDS&PDF.xls")
Set sayfam = Belgem.Workbooks("CoA&MSDS&PDF.xls").Sheets("Etken")
yer = sayfam.[a65536].End(3).Row + 1


Set S1 = Sheets("Etken")

yer1 = S1.[a65536].End(3).Row



    sayfam.Cells(yer, 1) = "azra"
    
Belgem.Workbooks("CoA&MSDS&PDF.xls").Save
Belgem.Workbooks("CoA&MSDS&PDF.xls").Close
Set Belgem = Nothing
Set sayfam = Nothing

asi_kral · 3 Mayıs 2012

Merhaba

Kod:

Option Explicit
Sub kapalı_kayıt_1967()
'Konu       :   Kapalı Dosya Açıkda Olsa Kayıt Yap
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As String, kral As Worksheet, _
yol As String, kitap As String, hücre As Long
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\"
kitap = "Kayıt.xls"
On Error GoTo asi
Workbooks(kitap).Close
asi:
Workbooks.Open (yol & kitap)
Set kral = Workbooks(kitap).Sheets("Sayfa1")
hücre = kral.Range("A" & Rows.Count).End(xlUp).Row
kral.Range("A" & hücre + 1) = "asi_kral_1967"
Workbooks(kitap).Save
Workbooks(kitap).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Bu şekilde düzenlerseniz işiniz görülebilir.

Murat OSMA · 3 Mayıs 2012

Alternatif olarak kullanabilirsiniz...

Kod:

Sub Emre()
    Dim con As Object, rs As Object
    Dim sorgu As String
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
        con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _
        "\CoA&MSDS&PDF.xls;extended properties=""excel 8.0;hdr=no"""
        sorgu = "Select F1 FROM [Etken$]"
        rs.Open sorgu, con, 1, 3
        rs.Addnew
        rs.Fields(0) = "azra"
        rs.Update
        rs.Close: con.Close
    sorgu = vbNullString: Set rs = Nothing: Set con = Nothing
End Sub

udentr2002 · 3 Mayıs 2012

merhaba

kodu kendime göre uyarlamaya çalıştım. Amam olmadı.

veriyi göndermek istediğim ve veriyi gönderdiğim her iki dosyada aynı klasör altında dosyayı açıyor salt okunur olarak. değişikliği kaydetmek istermisiniz diye soruyor evet diyorum ama

dosyayı açtığımda veriyi kaydetmemiş olduğunu görüyorum.

Kod:

Sub kapalı_kayıt_1967()
'Konu       :   Kapalı Dosya Açıkda Olsa Kayıt Yap
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As String, kral As Worksheet, _
yol As String, kitap As String, hücre As Long
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\"
kitap = "CoA&MSDS&PDF.xls"
On Error GoTo asi
Workbooks(kitap).Close
asi:
Workbooks.Open (yol & kitap)
Set kral = Workbooks(kitap).Sheets("Etken")
hücre = kral.Range("A" & Rows.Count).End(xlUp).Row
kral.Range("A" & hücre + 1) = "azra"
Workbooks(kitap).Save
Workbooks(kitap).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

ben kodu yazarken mi yanlış yapıyorum acaba?

udentr2002 · 3 Mayıs 2012

Murat hocam,

Kodunu kullandığımda ilgili sayfaya yazıyor ama

a stünunda çok alta bir yere yazıyor.

ben kodu çalıştırdığım yerdeki son dolu satırın hepsini kopyalayıp
veriyi göndermek istediğim dosyanın Etken adlı sayfasının en son boş hücreye o satırı yapıştırmasını istiyorum. Bu şekilde kodda nasıl bir değişiklik yapmak gerekir?

asi_kral · 3 Mayıs 2012

udentr2002' Alıntı:
merhaba

kodu kendime göre uyarlamaya çalıştım. Amam olmadı.

veriyi göndermek istediğim ve veriyi gönderdiğim her iki dosyada aynı klasör altında dosyayı açıyor salt okunur olarak. değişikliği kaydetmek istermisiniz diye soruyor evet diyorum ama

dosyayı açtığımda veriyi kaydetmemiş olduğunu görüyorum.

Kod:

Sub kapalı_kayıt_1967() 'Konu : Kapalı Dosya Açıkda Olsa Kayıt Yap 'Mail : m.batu.1967@gmail.com 'Msn : m.batu.1967@hotmail.com.tr 'Skype : m.batu.1967 'Coder By : asi_kral_1967 Dim asi As String, kral As Worksheet, _ yol As String, kitap As String, hücre As Long Application.ScreenUpdating = False yol = ThisWorkbook.Path & "\" kitap = "CoA&MSDS&PDF.xls" On Error GoTo asi Workbooks(kitap).Close asi: Workbooks.Open (yol & kitap) Set kral = Workbooks(kitap).Sheets("Etken") hücre = kral.Range("A" & Rows.Count).End(xlUp).Row kral.Range("A" & hücre + 1) = "azra" Workbooks(kitap).Save Workbooks(kitap).Close Application.ScreenUpdating = True MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _ vbInformation, "asi_kral_1967" End Sub

ben kodu yazarken mi yanlış yapıyorum acaba?

Dosyanızı ekler misiniz_?

numan şamil · 3 Mayıs 2012

asi_kral_1967' Alıntı:

Merhaba

Kod:

Option Explicit
Sub kapalı_kayıt_1967()
'Konu       :   Kapalı Dosya Açıkda Olsa Kayıt Yap
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As String, kral As Worksheet, _
yol As String, kitap As String, hücre As Long
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\"
kitap = "Kayıt.xls"
On Error GoTo asi
Workbooks(kitap).Close
asi:
Workbooks.Open (yol & kitap)
Set kral = Workbooks(kitap).Sheets("Sayfa1")
hücre = kral.Range("A" & Rows.Count).End(xlUp).Row
kral.Range("A" & hücre + 1) = "asi_kral_1967"
Workbooks(kitap).Save
Workbooks(kitap).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Bu şekilde düzenlerseniz işiniz görülebilir.

Merhaba
kral.Range("A" & hücre + 1) = "asi_kral_1967"
Yukarıdaki kodda
Örneğin
A4 hücresinde yazan değeri kapalı veya açık dosyaya göndermek için ne gibi değişiklik yapmalıyız

Murat OSMA · 3 Mayıs 2012

udentr2002' Alıntı:
Murat hocam,

Kodunu kullandığımda ilgili sayfaya yazıyor ama

a stünunda çok alta bir yere yazıyor.

ben kodu çalıştırdığım yerdeki son dolu satırın hepsini kopyalayıp
veriyi göndermek istediğim dosyanın Etken adlı sayfasının en son boş hücreye o satırı yapıştırmasını istiyorum. Bu şekilde kodda nasıl bir değişiklik yapmak gerekir?

Yukarıdaki satırlar boş değildir...
Boş görünen satırları seçip silin, bu şekilde tekrar denediğinizde olacaktır..

asi_kral · 3 Mayıs 2012

numan şamil' Alıntı:
Merhaba
kral.Range("A" & hücre + 1) = "asi_kral_1967"
Yukarıdaki kodda
Örneğin
A4 hücresinde yazan değeri kapalı veya açık dosyaya göndermek için ne gibi değişiklik yapmalıyız

Merhaba

Kod:

kral.Range("A" & hücre + 1) = range("A4")

şeklinde deneyin.

numan şamil · 3 Mayıs 2012

asi_kral_1967' Alıntı:
Merhaba

Kod:

kral.Range("A" & hücre + 1) = range("A4")

şeklinde deneyin.

Merhaba
Malesef olmadı
kral.Range("A" & hücre + 1) = "asi_kral_1967"
Şeklinde oluyor
Fakat
kral.Range("A" & hücre + 1) = range("A4")
Şeklinde olmuyor

Ekte örnek dosya gönderiyorum bakabilirmisiniz

asi_kral · 3 Mayıs 2012

numan şamil' Alıntı:
Merhaba
Malesef olmadı
kral.Range("A" & hücre + 1) = "asi_kral_1967"
Şeklinde oluyor
Fakat
kral.Range("A" & hücre + 1) = range("A4")
Şeklinde olmuyor

Ekte örnek dosya gönderiyorum bakabilirmisiniz

Merhaba

Kod:

Option Explicit
Sub kapalı_kayıt_1967()
'Konu       :   Kapalı Dosya Açıkda Olsa Kayıt Yap
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As String, kral As Worksheet, _
yol As String, kitap As String, hücre As Long
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\"
kitap = "Kayıt.xls"
On Error GoTo asi
Workbooks(kitap).Close
asi:
Workbooks.Open (yol & kitap)
Workbooks("Deneme.xls").Activate
Set kral = Workbooks(kitap).Sheets("Sayfa1")
hücre = kral.Range("A" & Rows.Count).End(xlUp).Row
'kral.Range("A" & hücre + 1) = "asi_kral_1967"
kral.Range("A" & hücre + 1) = Range("A4")
Workbooks(kitap).Save
Workbooks(kitap).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Bu şekilde dener misiniz_?

Murat OSMA · 3 Mayıs 2012

Son eklediğiniz dosylar için alternatif...

numan şamil · 3 Mayıs 2012

asi_kral_1967' Alıntı:

Merhaba

Kod:

Option Explicit
Sub kapalı_kayıt_1967()
'Konu       :   Kapalı Dosya Açıkda Olsa Kayıt Yap
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As String, kral As Worksheet, _
yol As String, kitap As String, hücre As Long
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\"
kitap = "Kayıt.xls"
On Error GoTo asi
Workbooks(kitap).Close
asi:
Workbooks.Open (yol & kitap)
Workbooks("Deneme.xls").Activate
Set kral = Workbooks(kitap).Sheets("Sayfa1")
hücre = kral.Range("A" & Rows.Count).End(xlUp).Row
'kral.Range("A" & hücre + 1) = "asi_kral_1967"
kral.Range("A" & hücre + 1) = Range("A4")
Workbooks(kitap).Save
Workbooks(kitap).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Bu şekilde dener misiniz_?

Teşekkürler sorunsuz çalışıyor

asi_kral · 3 Mayıs 2012

numan şamil' Alıntı:
Teşekkürler sorunsuz çalışıyor

Kolay Gelsin.

udentr2002 · 3 Mayıs 2012

Hocam her ikinizede ilginiz için teşekkür ederim.

Ekli klasör olarak dosyaları gönderiyorum.

Sonuç olarak.

Ar-Ge stok adlı dosyada etken adlı sayfadaki butona tıkladığımda en son satırı,
CoAMSDSPDF adlı dosyanın Etken isimli sayfasının en son boş satırına kopyalayacak.

Böyle bir kodu nasıl yapabilirim.

Murat OSMA · 3 Mayıs 2012

Dosyalar değişince benim hevesim kaçıyor...

Benden bu kadar.

asi_kral · 3 Mayıs 2012

udentr2002' Alıntı:
Hocam her ikinizede ilginiz için teşekkür ederim.

Ekli klasör olarak dosyaları gönderiyorum.

Sonuç olarak.

Ar-Ge stok adlı dosyada etken adlı sayfadaki butona tıkladığımda en son satırı,
CoAMSDSPDF adlı dosyanın Etken isimli sayfasının en son boş satırına kopyalayacak.

Böyle bir kodu nasıl yapabilirim.

Merhaba
Boş bir module kopyalayın ve deneyin.

Kod:

Option Explicit
Sub kapalı_kayıt_1967()
'Konu       :   Kapalı Dosya Açıkda Olsa Kayıt Yap
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As String, kral As Worksheet, a As Long, _
yol As String, kitap As String, hücre As Long
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\"
kitap = "CoA&MSDS&PDF.xls"
On Error GoTo asi
Workbooks(kitap).Close
asi:
Workbooks.Open (yol & kitap)
Workbooks("AR-GE STOK.xls").Activate
Set kral = Workbooks(kitap).Sheets("Etken")
a = Range("A" & Rows.Count).End(xlUp).Row
hücre = kral.Range("A" & Rows.Count).End(xlUp).Row
Range("A" & a & ":V" & a).Copy Destination:=kral.Range("A" & hücre + 1)
Workbooks(kitap).Save
Workbooks(kitap).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

asi_kral · 3 Mayıs 2012

Murat OSMA' Alıntı:
Dosyalar değişince benim hevesim kaçıyor...

Benden bu kadar.

Merhaba
Dosyalar farklı kişilerin yanlış oldu sanırım.

udentr2002 · 3 Mayıs 2012

evet

Malesef NUman şamil arkadaşımız da benim açtığım konu içerisinden sorunca dosyalar karıştı

udentr2002 · 3 Mayıs 2012

Asi kral üstat,

Tekrar emeğin için teşekkür ederim.

Yalnız, sadece a stünunda yazan hücreyi atıyor. satırın hepsini kopyalayıp atabilmesi için ne yapmak lazım.

kapalı dosyaya veri göndermek

udentr2002

asi_kral

Özel Üye

Murat OSMA

Altın Üye

udentr2002

udentr2002

asi_kral

Özel Üye

numan şamil

Destek Ekibi

Murat OSMA

Altın Üye

asi_kral

Özel Üye

numan şamil

Destek Ekibi

Ekli dosyalar

asi_kral

Özel Üye

Murat OSMA

Altın Üye

Ekli dosyalar

numan şamil

Destek Ekibi

asi_kral

Özel Üye

udentr2002

Ekli dosyalar

Murat OSMA

Altın Üye

asi_kral

Özel Üye

Ekli dosyalar

asi_kral

Özel Üye

udentr2002

udentr2002