Arka Planda Kayıt

Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
Yapmaya çalıştığım programımda, personel ekle butonunu tıkladığımda, hazırladığım şablonu kopyalayıp, personel isminde yeni bir excel sayfası oluşturulacak. Çok uğraştım ama dosya açılmadan bu kayıt işlemini gerçekleştiremedim. Ben anlattığım bu olayın dosyalar açılmadan arka planda gerçekleşmesini istiyorum. Yardımlarınızı bekliyorum.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Ne istediğiniz tam olarak anlaşılmıyor, yapmak istediğiniz eklediğiniz dosyayı farklı kaydetmekmidir.
 
Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
Öncellikle ilginizden dolayı teşekkürederim.
Yapmak istediğim, her personele ayrı ayrı excel sayfası oluşturmak. Ben burda üç şey istiyorum
1. Her personelin sayfasının biçimi benim oluşturduğum şablonuma benzesin.
Yani D:\tiglioglu_insaat\personel\MusBos.xls sayfasına benzesin

2. Her personelin sayfası, personelin kendi ismiyle kaydedilsin.
Örnek: kamil poyraz.xls , ahmet sarı.xls gibi

3. Bu işlemler hiçbir excel sayfası açılmadan gerçekleşsin.
 
Son düzenleme:
Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
benim gönderdiğim sayfa personel kayıt sayfası, yani ben personelleri bu sayfadan kaydedeceğim.
Şablonum ise D:\tiglioglu_insaat\personel\MusBos.xls
 
Katılım
25 Aralık 2005
Mesajlar
4,160
Excel Vers. ve Dili
MS Office 2010 Pro Türkçe
Sayın kmlpyrz,

Access de yaptığım bir uygulamadan bir excel uygulamasındaki formu oluşturup açıyordum kodları ekde:

Kod:
Set xlApp = CreateObject("Excel.Application")
    tarih1 = Format(Me.Tarih, "mmmm" & "_yyyy")
        
    Name1 = CurrentProject.Path & "\form118\" & tarih1 & ".xls"
    strFileName = tarih1 & ".xls"
    strFilePath = fReturnFilePath(strFileName, CurrentProject.Path)
    If strFilePath <> Name1 Then
        [B] xlApp.Workbooks.Add(CurrentProject.Path & "\Form118.xlt").SaveAs Name1
[/B]    End If
    xlApp.Workbooks.Open Name1
Burada formlara günlük tarihle aynı olan adları veriyordum. Koyu olarak yazılan satır ise xlt formatında (Excel şablonu) kayıtlı Form118.xlt göre yeni bir excel belgesi oluşturuyordum. Ancak bu arada bir de kontrol oluşturmanız gerekiyor. Eğer daha önce dosya oluşturulmuş ise hata veriyor. O zamn da oluşturulmuşsa sadece uygulamayı açıyordu. Tabi accessdeki verileri uygun yere taşıyarak.

Aşağıdaki kodlardaki fonksiyonlar uygulamanın olup olmadığını araştırıp geriye uygulama adını döndürüyorlar.

Kod:
Option Compare Database
'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fReturnFilePath(strFileName As String, _
    strDrive As String) As String
Dim varItm As Variant
Dim strFiles As String
Dim strTmp As String
    
    If InStr(strFileName, ".") = 0 Then
        MsgBox "Sorry!! Need the complete name", vbCritical
        Exit Function
    End If
    
    strFiles = ""
    With Application.FileSearch
        .NewSearch
        .LookIn = strDrive
        .SearchSubFolders = True
        .Filename = strFileName
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If .Execute > 0 Then
            For Each varItm In .FoundFiles
                strTmp = fGetFileName(varItm)
                If strFileName = strTmp Then
                    fReturnFilePath = varItm
                    Exit Function
                End If
            Next varItm
        End If
    End With
End Function

Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
    intLen = Len(strFullPath)
    If intLen Then
        For intPos = intLen To 1 Step -1
            'Find the last \
            If Mid$(strFullPath, intPos, 1) = "\" Then
                fGetFileName = Mid$(strFullPath, intPos + 1)
                Exit Function
            End If
        Next intPos
    End If
End Function
'******************** Code End **************************

İyi çalışmalar:)
 
Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
Sayın modalı sorunumla ilgilendiğiniz için öncellikle size çok teşekkürederim. Excel konusunda iyi olmama rağmen, şu VBA kodlamasını bir türlü anlayamıyorum. Hep sarı uyarı almak benim canımı çok sıkıyor.
Gönderdiğiniz kod üzerinde, isteklerime göre nasıl değişiklikler yapabileceğimi sorsam acaba çok şey mi istemiş olurum?
 
Son düzenleme:
Katılım
25 Aralık 2005
Mesajlar
4,160
Excel Vers. ve Dili
MS Office 2010 Pro Türkçe
Sayın kmlpyrz,

Yeni oluşturulacak excel dosyalarının içine herhangi bir bilgi transfer olacak mı? Öyle ise şablon dosyanızı da yollamanız gerekiyor.
 
Katılım
25 Aralık 2005
Mesajlar
4,160
Excel Vers. ve Dili
MS Office 2010 Pro Türkçe
Sayın kmlpyrz,

Örneğiniz hazır. Ancak şablon olarak kullanacağınız dosyayı şablon olarak kaydetmeniz gerekiyor aynı dizine. Dosyayı açın farklı kaydetten türünü şablon olarak ayarlayıp kaydedin.

Kolay gelsin iyi çalışmalar
 
Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
TeŞekkÜrederİm

Sayın modalı,
Öncellikle ilginizden ve yardımlarınızdan dolayı çok teşekkürederim. Hazırladınız kod sayesinde EKLE butonu tam istediğim gibi çalışıyor artık.
Eğer bilgi transfer edecekseniz şablonuda göndermelisiniz diye ileti yazmışsınız. Evet bilgi transferide olacak, bunun için şablonumu da gönderiyorum.
Siz sadece isim kısmının transferinin nasıl olacağını gösterirseniz, ben diğer transfer kısımlarını yapabilirim heralde.
İyi çalışmalar.
 
Katılım
25 Aralık 2005
Mesajlar
4,160
Excel Vers. ve Dili
MS Office 2010 Pro Türkçe
Sayın kmlpyrz,

İlk gönderdiğiniz uygulamanın kodlarını aşağıdakilerle değiştirirseniz aynı zamanda yeni açılan excel dosyasına verilerinizin de taşındığını görürsünüz.

Kod:
Private Sub CommandButton1_Click()
Dim xlApp As New Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim Name1 As String
Dim adı As String
Dim strFilePath, strPath As String
Dim strFileName As String
ReDim Veri(5) As Variant
Veri(0) = Range("O26")  'Adı Soyadı
Veri(1) = Range("O31")  'Arşiv No
Veri(2) = Range("O51")  'Adres
Veri(3) = Range("O36")  'GSM No
Set xlApp = CreateObject("Excel.Application")
adı = Range("O26")
Name1 = "D:\tiglioglu_insaat\personel\" & adı & ".xls"
strFileName = adı & ".xls"
strPath = "D:\tiglioglu_insaat\personel\"
strFilePath = fReturnFilePath(strFileName, strPath)
    If strFilePath <> Name1 Then
         xlApp.Workbooks.Add("D:\tiglioglu_insaat\personel\MusBos.xlt").SaveAs Name1
    End If
    xlApp.Workbooks.Open Name1
    
xlApp.Range("C6") = Veri(0)
xlApp.Range("O18") = Veri(1)
xlApp.Range("O24") = Veri(2)
xlApp.Range("O40") = Veri(3)
xlApp.Workbooks.Close
Set xlApp = Nothing
End Sub
Eğer yeni dosyanın açık kalmasını istiyorsanız xlApp.Workbooks.Close satırının çalışmasını durdurun.

İyi çalışmalar:)
 
Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
Sayın modalı çok teşekkürederim ama hata uyarısı alıyorum. Uyarıyı jpg formatında gönderiyorum. Saygılarımla.
 
Katılım
25 Aralık 2005
Mesajlar
4,160
Excel Vers. ve Dili
MS Office 2010 Pro Türkçe
Sayın kmlpyrz,

Siz kodları yeni bir excel dosyasına mı kopyaladınız? Bu kodları ilk gönderdiğiniz dosyanın içine yapıştırmanız gerekir. Hata uyarısında tanımsız fonksiyon diyor. Dikkat ettiyseniz fonksiyon uygulamanın içindeki Modülde. Yeni bir yere kopyaladıysanız Modülü de kopyalamanız gerekir.

İyi çalışmalar
 
Katılım
17 Eylül 2006
Mesajlar
119
Excel Vers. ve Dili
Excel 2003 Türkçe
Sayın modalı

Evet haklısınız, yaptığım değişiklikle komut artık çalışıyor. program tam istediğim gibi oldu. Emeğinize ve yüreğinize sağlık.
Gösterdiğiniz ilgi, yardım ve sabırdan dolayı size çok teşekkürederim.

VBA öğrenme konusunda bana ne gibi tavsiyelerde bulunabilirsiniz. Bende sizler gibi olmasada basit bazı makrolar yazabilmeyi çok istiyorum.:hey:
 
Üst