copy Yapıştır ile Excelden veri alımı
Tarih
02/04/2013 19:46
Konu Sahibi
fatih karagöl
Yorumlar
0
Okunma
1226
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy



fatih karagöl
Aktif Üye
Kullanici Avatari
Aktif Üye
167
05/10/2010
88
Edirne
-
15/12/2015,17:38
Selamlar.
Forumda sıklıkla excelden accese veri girişi sorularına denk geliyorum.
Aşağıdaki fonksiyon 8 kolonlu bir datasheet formuna veri almaktadır.
Örnek eklemiyorum çünkü alınacak veri yapısı değiştikçe kodda değişecektir.
Kodun genel mantığı anlamak gerekmektedir.
Üstadlardan kodun iyileştirilmesi amacı ile düzeltme gelirse ayrıca memnun olurum.
Birilerinin işine yaraması dileği ile

Private Sub copyPastFromExcell()
Dim intAccount As Long
Dim lAcc As Integer
Dim clipboard As MSForms.DataObject
Dim ctl As Control


'SessionInformation
'**********************************************************************************
'**********************************************************************************
'**********************************************************************************

Set clipboard = New MSForms.DataObject
fSiraNo = Me.CurrentRecord
strKolon = Me.ActiveControl.Name

clipboard.GetFromClipboard
clipText = clipboard.GetText
clipTextSub = clipboard.GetText
Set clipboard = Nothing
xDelta = Me.ActiveControl.ColumnOrder()
W = 8 - Me.ActiveControl.ColumnOrder()

l = Len(clipText)
For i = 1 To l
If IsNumeric(Right(clipText, i)) Then GoTo temiz:
If IsCharAlphaNumeric(Asc(Right(clipText, i))) Then GoTo temiz:
clipTextSub = Left(clipText, l - i)
Next
temiz:
clipText = clipTextSub
starter = xDelta

Do While Not clipText = ""
If InStr(clipText, Chr(10)) > 0 Then iRow = Mid(clipText, 1, InStr(clipText, Chr(10)) - 2) Else iRow = clipText
'----------------------------------------------------------------
Do While Not iRow = ""
If InStr(iRow, vbTab) > 0 Then iRecord = Left(iRow, InStr(iRow, vbTab) - 1) Else iRecord = iRow
If Right(iRecord, 1) = vbTab Then iRecord = Left(iRecord, Len(iRecord) - 1)
For Each ctl In Me.Controls
If ctl.ControlType = 109 Then
If ctl.ColumnOrder() = starter Then
ctl.value = iRecord
If InStr(iRow, vbTab) > 0 Then iRow = Mid(iRow, InStr(iRow, vbTab) + 1) Else iRow = "": starter = 8
starter = starter + 1
Exit For
End If
End If
Next
If starter = 8 Then
fSiraNo = fSiraNo + 1
DoCmd.GoToRecord , , acGoTo, fSiraNo
iRow = ""
starter = xDelta
End If
Loop
'----------------------------------------------------------------

fSiraNo = fSiraNo + 1
DoCmd.GoToRecord , , acGoTo, fSiraNo
starter = xDelta
If InStr(clipText, Chr(10)) > 0 Then clipText = Mid(clipText, InStr(clipText, Chr(10)) + 1) Else clipText = ""
Loop

Me.Recalc
'Me.Refresh

'hariciVeriUygunlugu

'***************************************************************************************************
End Sub
Hayatta listbox kullanmam..
Cevapla







Konuyu Okuyanlar: 1 Ziyaretçi


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Tarih Son Yorum
  çok güzel bir copy paste programı accessman 3 2.392 25/03/2013, 21:14 accessman
  copy files örnekleri accessman 1 1.447 01/04/2012, 15:14 Yandemir


Türkçe Çeviri: MCTR, Forum Yazılımı: MyBB, © 2002-2016 MyBB Group.
DMCA.com Protection Status
© Desing by XSTYLED| Develops by ozanakkaya