Skip to main content

AccessTr.neT


copy Yapıştır ile Excelden veri alımı

copy Yapıştır ile Excelden veri alımı

#1
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

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

Yorum yapmak için üye olmanız gerekiyor

ya da