Xin sửa dùm code tạo mã vạch bằng chương trình ActiveBarcode

[giamngucgames]

Chào các anh chị, em đang cần code tạo mã vạch bằng VBA. Lang thang trên Net tim được chương trình này, rất hay nhưng trình độ có hạn nên em không sửa được code vba theo ye muốn

- Code của file như sau:

Public Sub Create_Barcodes()
' Copyright (c) by Schenk & Horn, www.activebarcode.de


ScreenUpdating = False
' Column the data is stored
DataColumn = "A"
' Number of Row the data begins
DataRow = 8
' Number of Column the barcodes shall be placed
BarcodeColumn = "B"


i = DataRow
continue = True
While continue


  ' CurrentCell
  DataCell = DataColumn & i
  CurrentCell = BarcodeColumn & i
  
  ' Get Size of cell
  MyHeight = Range(CurrentCell).Height
  MyWidth = Range(CurrentCell).Width
  MyTop = Range(CurrentCell).Top
  MyLeft = Range(CurrentCell).Left
  
  ' Place the barcode control exactly into a cell
  ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarcodeCtrl.1", Link:=False _
     , DisplayAsIcon:=False, Width:=MyWidth, Height:=MyHeight, Top:=MyTop, Left:=MyLeft).Select
  BarcodeName = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name
  
  ' Set Barcode properties
  ActiveSheet.OLEObjects(BarcodeName).Object.ShowText = True
  ActiveSheet.OLEObjects(BarcodeName).Object.Font.Size = 8
  ActiveSheet.OLEObjects(BarcodeName).Object.Borderwidth = 0
  ActiveSheet.OLEObjects(BarcodeName).Object.Borderheight = 1
  ActiveSheet.OLEObjects(BarcodeName).Object.Type = 14 ' code 128
  ActiveSheet.OLEObjects(BarcodeName).Object.PrintFix = True


  ' set Barcode text
  ActiveSheet.OLEObjects(BarcodeName).Object.Text = Range(DataCell)


  ' next data if available
  continue = Len(Range(DataColumn & i + 1)) > 11
  i = i + 1
 
Wend


ActiveSheet.OLEObjects(BarcodeName).Object.PrintFix = False
ScreenUpdating = True


End Sub

Em không muốn tạo nút hoặc Alt + F8 để chạy marco nên em nhờ các anh sửa lại thành hàm được không ạ, khi thay đổi giá trị thì code sẽ tự đổi mã vạch luôn (em đã viết Worksheet_Change tại vị trí của Sheet cần hiển thị mã vạch)

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$A$8" Then
       Call Create_Barcodes
   End If
End Sub

Download chương trình theo link sau: http://www.mediafire.com/?3lxg91gh52w0a5m

 

[giamngucgames]

Anh chị có thể tham khảo theo đường link sau, mong diễn đàn giúp em với: http://www.activebarcode.com/howto/excel_vba.html

 

[giamngucgames]

Sau 1 hồi lục lọi hướng dẫn của nó em cũng tìm ra được 1 số vấn đền và sửa lại Code như sau

Sub Create_Barcodes()


    
    ScreenUpdating = False


  ' CurrentCell
    DataCell = "A8"
    CurrentCell = "B8"
  
  ' Get Size of cell
    MyHeight = Range(CurrentCell).Height
    MyWidth = Range(CurrentCell).Width
    MyTop = Range(CurrentCell).Top
    MyLeft = Range(CurrentCell).Left
  
  ' Enlarge the cell height to 30 pixels
    'Range(CurrentCell).RowHeight = 90
  
  ' Place the barcode control exactly into a cell
    ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarcodeCtrl.1", Link:=False _
       , DisplayAsIcon:=False, Width:=MyWidth, Height:=MyHeight, Top:=MyTop, Left:=MyLeft).Select
   
    BarcodeName = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name


    ' Thiet lap thuoc tinh cho Barcode
    ActiveSheet.OLEObjects(BarcodeName).Object.ShowText = True      ' True neu muon hien text, False khong hien
    ActiveSheet.OLEObjects(BarcodeName).Object.Font.Name = "Arial"  ' Font
    ActiveSheet.OLEObjects(BarcodeName).Object.Font.Bold = True     ' Bold: Font in dam, Italic: In nghieng,
                                                                    ' Underline: Gach duoi,Strikethrough: Gach lung
    ActiveSheet.OLEObjects(BarcodeName).Object.Font.Size = 8        ' Co chu Text
    ActiveSheet.OLEObjects(BarcodeName).Object.Borderwidth = 0      ' Chieu rong bien ben trai va ben phai
    ActiveSheet.OLEObjects(BarcodeName).Object.Borderheight = 1     ' Chieu cao bien tren va bien duoi cua Barcode (Cang lon Barcode cang nho)
    ActiveSheet.OLEObjects(BarcodeName).Object.Type = 14            ' Code 128
    ActiveSheet.OLEObjects(BarcodeName).Object.PrintFix = True      '
    ActiveSheet.OLEObjects(BarcodeName).Object.Rotate = 0           ' Xoay ma vach
    ActiveSheet.OLEObjects(BarcodeName).Object.Alignment = 1        ' 0: Can trai, 1: Can giua, 2: Can phai
    'ActiveSheet.OLEObjects(BarcodeName).Object.BackColor = &HC0C0C0' Ma mau nen cua Barcode
    ActiveSheet.OLEObjects(BarcodeName).Object.ForeColor = &HFF&    ' Mau chu cua Barcode
    ' set Barcode text
    ActiveSheet.OLEObjects(BarcodeName).Object.Text = Range(DataCell)
    
    
    'DoEvents
    ScreenUpdating = True
    'ActiveSheet.OLEObjects(BarcodeName).Delete
End Sub

Nhưng khi chạy Marco này, mỗi lần chạy hàm lại tạo thêm 1 Barcode đè ngay lên Barcode tạo lần trước. Nhờ anh chị giúp đỡ em sửa lại Marco trên mỗi khi tạo thì Marco trên sẽ xóa Barcode trước rồi mới tạo mới

Em có gửi file đính kèm mong anh chị giúp đỡ, theo yêu cầu của file là em nhập thông tin từ 1 Sheet thì Barcode tạo bên Sheet khác

 

[giamngucgames]

Hix, không anh chị nào ngó ngàng tới buồn quá

 

[ndu96081631]

Hix, không anh chị nào ngó ngàng tới buồn quá

Test code của bạn mất công phải cài thêm BARCODE Object, trong khi chẳng có mấy người có nhu cầu này

 

[giamngucgames]

Cám ơn anh đã ghé qua, thực sự chỗ em hồ sơ nhiều em cũng muốn tạo barcode này để khi đóng thùng lưu trữ hoặc đi thẩm định em dùng máy quét để tạo list hồ sơ. Chứ nếu ngồi gõ mã công trình khoảng > 50 cuốn chết mết. Mong anh giúp đỡ

 

[ptm0412]

Không biết bạn dùng đầu đọc kèm theo phần mềm nào, nhưng bạn thử file dưới đây và cài đặt font kèm theo.

không cần VBA gì cả

 

[giamngucgames]

Cám ơn anh, cái font của anh không chỉnh được loại mã cần hiển thị. Anh dùng code của em anh có thể điều chỉnh được các loại mã Barcode hoặc QCode được hết anh ạ. Em gửi anh chị thêm file hướng dẫn của nó

 

[ptm0412]

Cám ơn anh, cái font của anh không chỉnh được loại mã cần hiển thị.

Mã cần hiển thị thế nào thì chọn loại font phù hợp là được. Chính vì tôi không biết bạn dùng phần mềm nào để đọc mã, phần mềm đó dùng font nào, và điều kiện của phần mềm là mã gồm bao nhiêu ký tự, có kèm khỏang trắng hay không, ...
Cái này chỉ có bạn biết. Và tài liệu này chính bạn cần đọc, chứ không phải người khác.

 

[giamngucgames]

Vâng cám ơn anh, em thường sử dụng loại Barcode 128, vấn đề ở trên em nhờ các anh sửa giúp em khi chạy marco đó sẽ tạo ra barcode tuy nhiên nêu em chạy tiếp marco 1 lần nữa nó sẽ tạo 1 barcode khác đè lên barcode cũ.
Chính vì mù mờ và không thạo code VBA nên em mới Nhờ các pro giúp đỡ sửa lại khi chạy marco nó sẽ xóa barcode cũ và tạo barcode mới theo dữ liệu mình thay đổi ở Sheet Input

 

[giamngucgames]

Cám ơn các anh rất nhiều em đã tìm ra giải pháp rồi, em viết thêm 1 hàm nữa trước khi tạo barcode nó sẽ xóa cái barcode trên đi và thực hiện mã lệnh trên. Nhân đây các anh cho em hỏi trong VBA nếu mình muốn lấy kết quả từ Sheet khác vào thì như thế nào ạ

  ' CurrentCell    DataCell = "A8"    CurrentCell = "B8"

CurrentCell = Sheet("Input")!B6 có được không ạ, em làm nó báo lỗi

 

[longzzxz90]

Bạn thân mến, bạn viết thêm 1 hàm xóa shape trước khi tạo code nữa là ok

Sub DeleteAllShapes()
'PURPOSE: Remove All Shape Objects From The Active Worksheet
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

End Sub

Sub goiform()
form_in.Show
End Sub

 

[anhdepjai]

Code 1D: có font để bạn chỉ cần đổi font thành fond 3code là xong. Chú ý: chuỗi ABCDEF thì bạn phải nhập là *ABCDEF* thì cái mã barcode hiện ra mới quẹt được
Ngoài ra, có 1 cách để tạo code 1D nữa bằng vba
Code 2D: có cả vba và google. Tôi gửi lên đây 1 đoạn trích từ file tạo code đã chỉnh 1 số thông số mà tôi đang dùng và thấy phù hợp (đậm nhạt/ kích cỡ).