excel-vba
CustomDocumentProperties w praktyce

Wprowadzenie

Organizowanie nowych numerów faktur

Zwiększanie numeru faktury i zapisywanie jej wartości jest częstym zadaniem. Korzystanie z CustomDocumentProperties (CDP) to dobra metoda przechowywania takich liczb w stosunkowo bezpieczny sposób w tym samym skoroszycie, ale unikanie wyświetlania powiązanych wartości komórek po prostu w niezabezpieczonym arkuszu roboczym.

Dodatkowa wskazówka:

Alternatywnie możesz wprowadzić wartości również w ukrytym arkuszu lub nawet tak zwanym „bardzo ukrytym” arkuszu (patrz Korzystanie z xlVeryHidden Sheets . Oczywiście możliwe jest zapisywanie danych również w plikach zewnętrznych (np. Plik ini, csv lub dowolny inny typ) lub rejestr.

Przykładowa treść :

Poniższy przykład pokazuje

• funkcja NextInvoiceNo, która ustawia i zwraca kolejny numer faktury,
• procedura DeleteInvoiceNo, która całkowicie usuwa CDP faktury, a także
• procedura showAllCDPs z listą całej kolekcji CDP ze wszystkimi nazwami. Nie używając VBA, możesz również wymienić je za pomocą informacji ze skoroszytu: Informacje | Właściwości [DropDown:] | Zaawansowane właściwości | Zwyczaj

Możesz uzyskać i ustawić kolejny numer faktury (ostatni bez plus jeden), po prostu wywołując wyżej wymienioną funkcję, zwracając wartość ciągu w celu ułatwienia dodawania prefiksów. „Faktura Nie” jest domyślnie używana jako nazwa CDP we wszystkich procedurach.

Dim sNumber As String
sNumber = NextInvoiceNo ()

Przykładowy kod:

Option Explicit

Sub Test()
  Dim sNumber As String
  sNumber = NextInvoiceNo()
  MsgBox "New Invoice No: " & sNumber, vbInformation, "New Invoice Number"
End Sub

Function NextInvoiceNo() As String
' Purpose: a) Set Custom Document Property (CDP) "InvoiceNo" if not yet existing
'          b) Increment CDP value and return new value as string
' Declarations
  Dim prop As Object
  Dim ret  As String
  Dim wb   As Workbook
' Set workbook and CDPs
  Set wb = ThisWorkbook
  Set prop = wb.CustomDocumentProperties

  ' -------------------------------------------------------
  ' Generate new CDP "InvoiceNo" if not yet existing
  ' -------------------------------------------------------
    If Not CDPExists("InvoiceNo") Then
    '  set temporary starting value "0"
       prop.Add "InvoiceNo", False, msoPropertyTypeString, "0"
    End If

  ' --------------------------------------------------------
  ' Increment invoice no and return function value as string
  ' --------------------------------------------------------
       ret = Format(Val(prop("InvoiceNo")) + 1, "0")
  ' a) Set CDP "InvoiceNo" = ret
       prop("InvoiceNo").value = ret
  ' b) Return function value 
       NextInvoiceNo = ret
End Function

Private Function CDPExists(sCDPName As String) As Boolean
' Purpose: return True if custom document property (CDP) exists
' Method: loop thru CustomDocumentProperties collection and check if name parameter exists
' Site: cf. http://stackoverflow.com/questions/23917977/alternatives-to-public-variables-in-vba/23918236#23918236
' vgl.: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other/using-customdocumentproperties-with-vba/91ef15eb-b089-4c9b-a8a7-1685d073fb9f
' Declarations
  Dim cdp As Variant      ' element of CustomDocumentProperties Collection
  Dim boo As Boolean      ' boolean value showing element exists
  For Each cdp In ThisWorkbook.CustomDocumentProperties
    If LCase(cdp.Name) = LCase(sCDPName) Then
       boo = True      ' heureka
       Exit For        ' exit loop
    End If
  Next
  CDPExists = boo          ' return value to function
End Function


Sub DeleteInvoiceNo()
' Declarations
  Dim wb     As Workbook
  Dim prop   As Object
' Set workbook and CDPs
  Set wb = ThisWorkbook
  Set prop = wb.CustomDocumentProperties

' ----------------------
' Delete CDP "InvoiceNo"
' ----------------------
 If CDPExists("InvoiceNo") Then
    prop("InvoiceNo").Delete
 End If

Napis końcowy

Sub showAllCDPs()
' Purpose: Show all CustomDocumentProperties (CDP) and values (if set)
' Declarations
  Dim wb      As Workbook
  Dim cdp     As Object

  Dim i       As Integer
  Dim maxi   As Integer
  Dim s       As String
' Set workbook and CDPs
  Set wb = ThisWorkbook
  Set cdp = wb.CustomDocumentProperties
' Loop thru CDP getting name and value
  maxi = cdp.Count
  For i = 1 To maxi
    On Error Resume Next    ' necessary in case of unset value
    s = s & Chr(i + 96) & ") " & _
            cdp(i).Name & "=" & cdp(i).value & vbCr
  Next i
' Show result string
  Debug.Print s
End Sub