Question

我需要一个VBA代码，可以在日期格式的单元格中自动插入条形码。

我的意思是，你在一个单元格中键入010101，然后移动到下一个单元格后，单元格会自动将010101转换为01/01/2001。

我已经有一个插入条形码的代码，但它只适用于具有文本格式的单元格。

我的代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
 Set MyIntersect = Intersect(Target, Cells)
 If (Not (MyIntersect Is Nothing)) And (Not IsEmpty(MyIntersect)) Then
  Dim UserData As String: UserData = MyIntersect.Value
  If Right(UserData, 2) <= Mid(CStr(Year(Date)), 3, 2) Then
   UserData = Left(UserData, 4) & "20" & Right(UserData, 2)
  Else
   UserData = Left(UserData, 4) & "19" & Right(UserData, 2)
  End If
  UserData = Left(UserData, 2) & "/" & Mid(UserData, 3, 2) & "/" & _ 
  Right(UserData, 4)
  Application.EnableEvents = False
  MyIntersect.Value = UserData
  Application.EnableEvents = True
 End If
End Sub

Answer 1

我找到了答案。诀窍是首先将intersection.value转换为long然后转换为string，如果其长度等于5，则将字符串添加零。用户必须仅将日期作为DDMMYY插入，否则代码将无效，除非稍后进行改进。

代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
Set MyIntersect = Intersect(Target, Cells)
 If (Not (MyIntersect Is Nothing)) And (Not IsEmpty(MyIntersect)) Then
  Dim UserData As String: UserData = CStr(CLng(MyIntersect.Value))
  If Len(UserData) = 5 Then UserData = "0" & UserData
  If Right(UserData, 2) <= Mid(CStr(Year(Date)), 3, 2) Then
   UserData = Left(UserData, 4) & "20" & Right(UserData, 2)
  Else
   UserData = Left(UserData, 4) & "19" & Right(UserData, 2)
  End If
  UserData = Left(UserData, 2) & "/" & Mid(UserData, 3, 2) & "/" & _
  Right(UserData, 4)
  Application.EnableEvents = False
  MyIntersect.Value = UserData
  Application.EnableEvents = True
 End If
End Sub

自动向日期单元格添加条形图

1 个答案: