header image

Makro: Dodaj nov artikel

Združljivost Microsoft Office Excel ‘97 do Microsoft Office Excel 2007
Prispevek / Article KIR – Šifrant in cenik artiklov
Opis / Summary

Makro na delovnem listu (poimenovanem “Šifrant artiklov”) poišče naslednjo vrstico za zadnjim vnosom in v posamezne celice te vrstice vnese potrebne formule.

Macro goes to the next row after last entry in the worksheet (named “Šifrant Artiklov” ; eng.: “Stock items)” and fills particular cells in that row fith formulas as necessary.

Odvisnosti / Dependencies brez / none
Public Sub DodajArtikel()
On Error GoTo ErrorHandler

  Dim oSheet As Worksheet
  Dim nRow As Integer

  With Application
    .ScreenUpdating = False
    .Cursor = xlWait
  End With

  Set oSheet = Sheets("Šifrant artiklov")

  With oSheet
    .Select
    .Unprotect
  End With

  Range("A65535").End(xlUp).Offset(1).Select
  nRow = ActiveCell.Row

  Range("A" & CStr(nRow)).Formula = _
    IIf(nRow > 5, "=A" & CStr(nRow - 1) & "+1", "=1")

  With Range("C" & CStr(nRow)).Validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
      Formula1:="=$C$5:$C$65536"
    .IgnoreBlank = True
    .ShowError = False
  End With

  With Range("D" & CStr(nRow)).Validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
      Formula1:="=$D$5:$D$65536"
    .IgnoreBlank = True
    .ShowError = False
  End With

   With Range("E" & CStr(nRow)).Validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
      Formula1:="=$M$2:$O$2"
    .ErrorTitle = "Napaka"
    .ErrorMessage = "Izbirate vrednost iz seznama."
    .IgnoreBlank = True
    .ShowError = True
  End With

  Range("H" & CStr(nRow)).Formula = _
    "=F" & CStr(nRow) & "*G" & CStr(nRow)
  Range("I" & CStr(nRow)).Formula = _
    "=F" & CStr(nRow) & "+H" & CStr(nRow)
  Range("J" & CStr(nRow)).Formula = _
    "=(1+E" & CStr(nRow) & ")*I" & CStr(nRow)

  Range("B" & CStr(nRow)).Select

FinalHandler:
  oSheet.Protect UserInterfaceOnly:=True, AllowFiltering:=True
  Set oSheet = Nothing
  With Application
    .ScreenUpdating = True
    .Cursor = xlDefault
  End With
  Exit Sub

ErrorHandler:
  MsgBox Err.Description, vbOKOnly, _
    "Napaka: " & Err.Number
  Resume FinalHandler

End Sub
  • Share/Bookmark

Odzivi

Pri uporabi dela morate v vašem izdelku navesti izvirnega avtorja na vidnem mestu in povezavo na to spletno mesto.

Avtor: P.J.
Web: http://office.blog.siol.net

PJ: Iščemo te pri meni. ;)

Pustite komentar

Tvoj odziv :

Komentiranje iz tujine je omogočeno zgolj prijavljenim uporabnikom !