Tạo macro in nhãn trên excel (1 người xem)

[tomato986]

Chào cả nhà em có một file này nhưng em không biết làm cách nào ma ra đựơc như thế, nhờ mọi người chỉ giúp em cách tạo nhãn. Cám ơn mọi người rất nhiều

 

[keentwo]

Chào cả nhà em có một file này nhưng em không biết làm cách nào ma ra đựơc như thế, nhờ mọi người chỉ giúp em cách tạo nhãn. Cám ơn mọi người rất nhiều

-cái này người viết code viết cũng có khó đâu đơn giản mà.Bạn chỉ cần đọc thôi là hiểu được mà

Public Sub indanhsach()
Dim i, j As Long
Dim d As Long
Dim N As Worksheet
Dim K As Worksheet
Set N = Sheet2
Set K = Sheet1
i = 4
j = 1
 'i chi so hang'
 'j chi so cot'
       
Do Until (N.Cells(i, 1) = "")
'DK dung thi dung'
'nhap ten'
    K.Cells(j, 1) = N.Cells(i, 2)
'dia chi'
    K.Cells(j + 1, 1) = N.Cells(i, 3)
'dien thoai'
    K.Cells(j + 2, 1) = "Code: " & N.Cells(i, 1) & " - Tel: " & N.Cells(i, 4)
  'chon fonrt chữ,chữ nghiêng Italic và đậm  Bold 
    K.Range("A" & j + 2 & ":" & "C" & j + 2).Font.Italic = True
    K.Range("A" & j & ":" & "C" & j).Font.Bold = True
    K.Range("A" & j & ":" & "C" & j).Font.Name = ".vntimeH"
    
'tao duong vien bao quanh dung Borders'
    K.Range("A" & j & ":" & "A" & j + 2).Borders(xlEdgeTop).LineStyle = xlContinuous
    K.Range("A" & j & ":" & "A" & j + 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
    K.Range("A" & j & ":" & "A" & j + 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
    K.Range("A" & j & ":" & "A" & j + 2).Borders(xlEdgeRight).LineStyle = xlContinuous
    
    
    '--------------------------------
    K.Cells(j, 3) = N.Cells(i + 1, 2)
    K.Cells(j + 1, 3) = N.Cells(i + 1, 3)
    K.Cells(j + 2, 3) = "Code: " & N.Cells(i + 1, 1) & " - Tel: " & N.Cells(i + 1, 4)
    
    
    K.Range("C" & j & ":" & "C" & j + 2).Borders(xlEdgeTop).LineStyle = xlContinuous
    K.Range("C" & j & ":" & "C" & j + 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
    K.Range("C" & j & ":" & "C" & j + 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
    K.Range("C" & j & ":" & "C" & j + 2).Borders(xlEdgeRight).LineStyle = xlContinuous
    j = j + 4
    i = i + 2
Loop
MsgBox "Runing completed"
K.Activate
End Sub