[es] - unos podataka formom u dvije radne knjige

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.

Profil

unos podataka formom u dvije radne knjige

^{29.06.2010. u 20:42 - pre 168 meseci}

molim pomoć
dali bi mi neko mogao nadograditi dolje Code: tako da mi unosi podatke iz User form i u radnu knjigu C:\Data.xlsm i to
code:
.Cells(lRow, 4).Value = Me.cboKljuc.List(lPart, 1)

a ovo da mi spoji i upiše u istu ćeliju:

.Cells(lRow, 5).Value = Me.cboPart.List(lPart, 1)
.Cells(lRow, 5).Value = Me.cboLocation.List(lPart, 1)

nakon unosa podataka da se naredbom "Save" pospremi unos u tu radnu knjigu (kada pospremam radnu knjigu u zadnju kolonu mi upisuje "computer name" i datum kada je podatak unešen.

Molim vas pomoć

Code:

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim lLocation As Long
Dim lKljuc As Long
Dim ws As Worksheet
Set ws = Worksheets("ListaUnosa")
'Nađi prvi prazan redak u bazi podataka

lRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

lPart = Me.cboPart.ListIndex
lPart = Me.cboLocation.ListIndex
lPart = Me.cboKljuc.ListIndex
'odabrati for a part number
If Trim(Me.cboPart.Value) = "" Then
Me.cboPart.SetFocus
MsgBox "Please enter a part number"
Exit Sub
End If
If Trim(Me.cboLocation.Value) = "" Then
Me.cboLocation.SetFocus
MsgBox "Please enter a part number"
Exit Sub
End If
If Trim(Me.cboKljuc.Value) = "" Then
Me.cboKljuc.SetFocus
MsgBox "Please enter a part number"
Exit Sub
End If

'Kopiranje podataka za bazu podataka

With ws
.Cells(lRow, 1).Value = Me.cboPart.Value
.Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
.Cells(lRow, 3).Value = Me.cboLocation.Value
.Cells(lRow, 4).Value = Me.cboLocation.List(lPart, 1)
.Cells(lRow, 5).Value = Me.cboKljuc.Value
.Cells(lRow, 6).Value = Me.cboKljuc.List(lPart, 1)
.Cells(lRow, 7).Value = Me.txtDate.Value
.Cells(lRow, 8).Value = Me.txtdo.Value
.Cells(lRow, 9).Value = Me.txtQty.Value
End With

'clear the data
Me.cboPart.Value = ""
Me.cboLocation.Value = ""
Me.cboKljuc.Value = ""
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtdo.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboPart.SetFocus
Me.cboLocation.SetFocus
Me.cboKljuc.SetFocus
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub Label7_Click()

End Sub

Private Sub txtdo_Change()

End Sub

Private Sub UserForm_Initialize()
Dim cPart As Range
Dim cLoc As Range
Dim cKljuc As Range
Dim ws As Worksheet
Set ws = Worksheets("IzvorniPodaci")

For Each cPart In ws.Range("PartIDList")
With Me.cboPart
.AddItem cPart.Value
.List(.ListCount - 1, 1) = cPart.Offset(0, 1).Value
End With
Next cPart

For Each cLoc In ws.Range("LocationList")
With Me.cboLocation
.AddItem cLoc.Value
.List(.ListCount - 1, 1) = cLoc.Offset(0, 1).Value
End With
Next cLoc

For Each cKljuc In ws.Range("KljucList")
With Me.cboKljuc
.AddItem cKljuc.Value
.List(.ListCount - 1, 1) = cKljuc.Offset(0, 1).Value
End With
Next cKljuc

Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtdo.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboPart.SetFocus
Me.cboLocation.SetFocus
Me.cboKljuc.SetFocus

End Sub