Skip to main content

AccessTr.neT M.



Excelde Aktarma Otomatik Satır Ekleme

Excelde Aktarma Otomatik Satır Ekleme

#1

Visual Basic Code
Private Sub Resim186_Click()
' REFERANSLARDAN MİCROSOFT Excel ... OBJECT LİBRARY TANIMLAMINIZ GEREKİYOR..
Dim Exapp As Excel.Application
Dim objWsh As Object
Dim rs As Recordset
Dim yol As String
Dim X As Long
Dim r As Range
Dim GTarih As String
Dim qdf As QueryDef
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim m, n, o, a As Variant
n = [Forms]![indexform]![GezintiAltFormu].[Form]![tur]
o = [Forms]![indexform]![GezintiAltFormu].[Form]![sekil]
m = [Forms]![indexform]![GezintiAltFormu].[Form]![amir]
If [Forms]![indexform]![GezintiAltFormu].[Form]![amir] <> "" Or [Forms]![indexform]![GezintiAltFormu].[Form]![amir] <> Null Then
a = [Forms]![indexform]![GezintiAltFormu].[Form]![amir]
Else
a = " takviyeler"
End If
Set Exapp = GetObject("", "excel.application")
If Err.Number <> 0 Then
  Err.Clear
        Set Exapp = CreateObject("Excel.Application")
End If
'exel yol tanımlıyoruz..
yol = CurrentProject.Path & "\deneme.xlsx"
'exceli açarak yükler.. false derseni.. exceli açmadan yükler.. size kalmış
Exapp.Visible = True
Exapp.Workbooks.Open yol

GTarih = Date
For Each objWsh In Exapp.Worksheets
        If objWsh.Name = GTarih Then
        Exapp.Worksheets(GTarih).Delete
        End If
Next
Exapp.Visible = True

Exapp.Sheets("Sayfa1").Copy Before:=Exapp.Sheets(1)
Exapp.ActiveSheet.Name = Date & "  " & a & " " & n

'eski Excel verileri siliyoruz...
With Exapp
        
          .Range("B14:N38").ClearNotes
          .Range("V14:P38").ClearNotes
          .Range("V14:V38").ClearNotes
End With
Exapp.Visible = True

'sorgu açılıyor...

Set qdf = CurrentDb.QueryDefs("iase_yolluk_sorgu")


qdf![Formlar!indexform!GezintiAltFormu.Form!amir] = m
qdf![Formlar!indexform!GezintiAltFormu.Form!tur] = n
qdf![Formlar!indexform!GezintiAltFormu.Form!sekil] = o

Set rs = qdf.OpenRecordset()

'intMaxCol = rs.Fields.Count
'Set rs = CurrentDb.OpenRecordset("iase_yolluk_sorgu")
'intMaxRow = rs.RecordCount

X = 14
Do While Not rs.EOF

With Exapp
    .Cells(X, 2) = rs("olursicil")          '2 B KOLONUDUR
    .Cells(X, 3) = rs("olurisim")
    .Cells(X, 4) = rs("MaasD")
  .Cells(X, 5) = "/"
    .Cells(X, 6) = rs("MaasK")
    .Cells(X, 7) = rs("rutbe2")
    .Cells(X, 8) = rs(Format("olurtarih1", "dd.mm.yyyy"))
  
    .Cells(X, 10) = rs("olurtarih2")
    .Cells(X, 12) = rs("GÜNÜ")
    .Cells(X, 13) = rs("GUNDELİK")
      .Cells(X, 14) = rs("t1")
      
      .Cells(X, 16) = rs("oluryeri")
      .Cells(X, 22) = rs("t1")
    
    
    
End With
rs.MoveNext
X = X + 1
Loop

rs.Close
End Sub

merhabalae, Ozan hocamın yardımlarıyla bu şekilde son haline gelmiş bir excele aktarma butonum var.    şablona aktarıyor. şablonda 25 kayıtlık bir alan var. acaba bu 25 kayıtlık alanı şablondan 1 e düşürsem.  Kayıt eklerken aynı biçimde yani satır eklese kayıt sayısı kadar eklese olurmu. maxrow ve maxcol ile bişeyler denedim ama beceremedim veya çok karmaşık yazdırdı. Yardımcı olabilirmisiniz.

Cevapla
#2
Hocam  Konuyu Silmeyi Bulamadım Size zahmet olmazsa silebilirmisiniz. boş yere kalabalık etmesin

Cevapla
...........
#3
sorunu çözebildiniz mi?
çözebildiyseniz cevabı paylaşmanız mümkün mü?
iyi çalışmalar

Cevapla
#4
Hocam Çözemedim ama  çok sık soru sorduğum için örnekte atamadım. birde yanlış şeyler yapmış gibi hissettim silinirse uygun olur diye düşündüm. Sonuçta Sizde hizmet veriyorsunuz birçok kişiye, gerçekten acceste bir numarasınız.  Kamu kurumlarının bilgisayararı genelde c#  oracle vs izin vermiyor. accessi içerisinde Vba ve sorgular olması gerçekten çok kullanışlı yapmış. Kamu kurumlarının ihtiyaçalrına cevap verebiliyor.  bu konuda emin olun bir numarasınız Türkiyede. Bu sebeple çok yoruyoruz sizi. Kusurmuza bakmayın.

Cevapla
...........

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da