Konu Araçları | Seçenekler: | Gösterim Stili
Tarih
02/04/2013 19:46
Konu Sahibi
fatih karagöl
Yorumlar
0
Okunma
1466
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.810 25/03/2013, 21:14 accessman
  copy files örnekleri accessman 1 1.697 01/04/2012, 15:14 Yandemir

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2017 MyBB Group.
Forum use Krzysztof "Supryk" Supryczynski addons.