02/04/2013, 19:46
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
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