copy Yapıştır ile Excelden veri alımı - Baskı Önizleme +- AccessTr.neT (https://accesstr.net) +-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html) +--- Forum: Access Örnekleri ve Uygulamaları (https://accesstr.net/forum-access-ornekleri-ve-uygulamalari.html) +--- Konu Başlığı: copy Yapıştır ile Excelden veri alımı (/konu-copy-yapistir-ile-excelden-veri-alimi.html) |
copy Yapıştır ile Excelden veri alımı - fatih karagöl - 02/04/2013 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 |