如何在excel工作表中生成條形碼

Question

只是一個簡短的問題，如何在Excel工作表中生成條形碼？條碼文本已在單元格中指定。

（不原意質量產生否則可以在MS Word中進行條形碼。）

Answer 1

選取條形碼文字的書寫範圍：

然後運行以下腳本：

Sub INSERT_BARCODE() 
    Const BarcodeWidth As Integer = 156 
    Dim ws As Worksheet, WdApp 
    Set ws = ActiveSheet 
    Set WdApp = CreateObject("Word.Application") 
    With WdApp.Documents.Add 
     .PageSetup.RightMargin = .PageSetup.PageWidth - .PageSetup.LeftMargin - BarcodeWidth 
     .Fields.Add(Range:=.Range, Type:=-1, Text:="DISPLAYBARCODE " & CStr(Selection.Value) & " CODE39 \d \t", PreserveFormatting:=False).Copy 
    End With 
    ws.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False 
    WdApp.Quit SaveChanges:=False 
    Set WdApp = Nothing 
End Sub 

注：

• 更改爲你喜歡的編碼規則。此示例使用​​3210規則。有關更多詳細信息，請參閱https://msdn.microsoft.com/en-us/library/hh745901(v=office.12).aspx。
• 調整BarcodeWidth整數以最適合條形碼。

BR〜

Answer 2

這是大規模過度specced您所需要的，但您可以根據需要拉位出來。

Sub Call_Barcode_Service() 

Dim strResource As String 
Dim strSize As String 
Dim iHgt As Integer 
Dim iWth As Integer 
Dim iGap As Integer 
Dim PictureGrab As String 
Dim lngLastRow As Long 

strSize = UCase(InputBox("How Big?", "Small, Medium or Large?", "L")) 

Select Case strSize 

    Case Is = "S" 
     iWth = 150 
     iHgt = 45 
     iGap = 3 


    Case Is = "M" 
     iWth = 150 
     iHgt = 60 
     iGap = 4 

    Case Is = "L" 
     iWth = 240 
     iHgt = 75 
     iGap = 5 

    Case Else 
     iWth = 250 
     iHgt = 75 
     iGap = 5 

End Select 


Set sel = Selection.SpecialCells(xlTextValues) 

Set news = Worksheets.Add() 
news.Name = "Barcodes" 
Set op = news.Range("A1") 

For Each acc In sel 
strResource = acc.Value 

PictureGrab = "http://www.barcodesinc.com/generator/image.php?code=" & strResource & "&style=197&type=C128B&width=" & iWth & "&height=" & iHgt & "&xres=1&font=1" 

Set sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, op.Left, op.Top, iWth, iHgt) 

With sh 

.Name = strResource 
.Line.Visible = False 
.Fill.UserPicture PictureGrab 

End With 

Set op = op.Offset(iGap + 1, 0).Range("A1") 

Next 

Range("G1").Select 

End Sub