日期差值3位补零格式化需求及VBA代码优化问询

现有VBA函数已通过DateDiff计算出当年1月1日到当前日期的天数差值DayNumber，但未将其处理为要求的3位数字格式（不足100时前置补零，例如1→001、50→050、123→123）。需要完善逻辑实现该格式化需求。

现有代码 #

Function DM_500()

  If LaserMarker.Drawing.GetMOsByName("KUNDVARNO").Count = 0 Then
    ErrorInLayout("KUNDVARNO")
    Exit Function
  End if

  If LaserMarker.Drawing.GetMOsByName("PDVAR4").Count = 0 Then
    ErrorInLayout("PDVAR4")
    Exit Function
  End if

  Set moCstmVaNo        = LaserMarker.Drawing.GetMOsByName("KUNDVARNO").Item(1)
  Set moBarcodeText2    = LaserMarker.Drawing.GetMOsByName("QRCODETEXT1").Item(1)
  Set moBarcodeText1    = LaserMarker.Drawing.GetMOsByName("QRCODETEXT2").Item(1)
  Set moBarcodeText     = LaserMarker.Drawing.GetMOsByName("QRCODETEXT3").Item(1)
  Set moBarcodeOutput   = LaserMarker.Drawing.GetMOsByName("PDVAR4").Item(1) 

  StrLength = Len(moCstmVaNo)
  
  'Remember length of customer itemno
  index = strlength 

  'Check length of customer itemno from SAP: customer item no 7 digits + 2 digits of revision no = 9 digits
  strlength = Len(moCstmVaNo)

  IF strLength = 9 Then
  'OK customer itemno incl 2 digits revision no.
  Elseif strLength = 7 Then
  'OK customer itemno 7 digits - excl revision no.
  Else
    strError = "WARNING!!!   WARNING!!!   WARNING!!!" + vbCrLf + vbCrLf 
    strError = strError + "Wrong number of characters in QR Code !!" + vbCrLf + strWorkString
    Msgbox strError 
    Exit Function 
  End if

  'add customer itemno incl. 2 digits of revision no
   CustNo = moCstmVaNo.value   

  'add Supplier id
   SuplyerID = "00019"

  'add Year 2 digits
   YY = Mid(Year(TodayDate),3,2)   

  'add days from 01-01-XXXX to Todays day.
   DayNumber = DateDiff("d", CDate("1/1/" & Year(TodayDate)), TodayDate)+1

  'Add fixt cust name
   CustName = "BDR"
    
  'Add Identifier
   Identifier = CHR(124)    ' "|" 124

  'Creating QR code value
   moBarcodeOutput.value = CustName & CustNo & Identifier & SuplyerID & Identifier & YY & DDD & Identifier & "$GSerialNo5$" 

  'Creating the QR code text
   
  moBarcodeText.Value =  YY & DDD & Identifier &  "$GSerialNo5Text$" 
  moBarcodeText1.Value = Identifier & SuplyerID & Identifier
  moBarcodeText2.Value = CustName & CustNo

End Function

解决方案 #

在VBA中，使用Format函数可以快速实现数字的补零格式化，只需在计算出DayNumber后添加一行代码，将其转换为3位带前导零的字符串并赋值给DDD变量：

' 将DayNumber格式化为3位带前导零的字符串
DDD = Format(DayNumber, "000")

Format函数的"000"参数表示固定输出3位数字，当原数字位数不足时，自动在左侧补0；若原数字本身是3位或更多（年积日最大为366），则直接保留有效数字（366会输出366，不会截断）。

修改后的完整代码 #

Function DM_500()

  If LaserMarker.Drawing.GetMOsByName("KUNDVARNO").Count = 0 Then
    ErrorInLayout("KUNDVARNO")
    Exit Function
  End if

  If LaserMarker.Drawing.GetMOsByName("PDVAR4").Count = 0 Then
    ErrorInLayout("PDVAR4")
    Exit Function
  End if

  Set moCstmVaNo        = LaserMarker.Drawing.GetMOsByName("KUNDVARNO").Item(1)
  Set moBarcodeText2    = LaserMarker.Drawing.GetMOsByName("QRCODETEXT1").Item(1)
  Set moBarcodeText1    = LaserMarker.Drawing.GetMOsByName("QRCODETEXT2").Item(1)
  Set moBarcodeText     = LaserMarker.Drawing.GetMOsByName("QRCODETEXT3").Item(1)
  Set moBarcodeOutput   = LaserMarker.Drawing.GetMOsByName("PDVAR4").Item(1) 

  StrLength = Len(moCstmVaNo)
  
  'Remember length of customer itemno
  index = strlength 

  'Check length of customer itemno from SAP: customer item no 7 digits + 2 digits of revision no = 9 digits
  strlength = Len(moCstmVaNo)

  IF strLength = 9 Then
  'OK customer itemno incl 2 digits revision no.
  Elseif strLength = 7 Then
  'OK customer itemno 7 digits - excl revision no.
  Else
    strError = "WARNING!!!   WARNING!!!   WARNING!!!" + vbCrLf + vbCrLf 
    strError = strError + "Wrong number of characters in QR Code !!" + vbCrLf + strWorkString
    Msgbox strError 
    Exit Function 
  End if

  'add customer itemno incl. 2 digits of revision no
   CustNo = moCstmVaNo.value   

  'add Supplier id
   SuplyerID = "00019"

  'add Year 2 digits
   YY = Mid(Year(TodayDate),3,2)   

  'add days from 01-01-XXXX to Todays day.
   DayNumber = DateDiff("d", CDate("1/1/" & Year(TodayDate)), TodayDate)+1

  ' 将DayNumber格式化为3位带前导零的字符串
   DDD = Format(DayNumber, "000")

  'Add fixt cust name
   CustName = "BDR"
    
  'Add Identifier
   Identifier = CHR(124)    ' "|" 124

  'Creating QR code value
   moBarcodeOutput.value = CustName & CustNo & Identifier & SuplyerID & Identifier & YY & DDD & Identifier & "$GSerialNo5$" 

  'Creating the QR code text
   
  moBarcodeText.Value =  YY & DDD & Identifier &  "$GSerialNo5Text$" 
  moBarcodeText1.Value = Identifier & SuplyerID & Identifier
  moBarcodeText2.Value = CustName & CustNo

End Function

内容的提问来源于stack exchange，提问作者Dragan