《自动生成条码标签》VBA源码

aaacjh

高手路过，请帮忙解释下以下源码含义？尤其是标签各行信息自动生成是由以下哪些源码控制的，先行谢过！
Sub CucreLbl()

    If Selection.Count < 1 Then
        MsgBox "Selection must >=1."
    End If
   
    Dim ColAWidth As Single
    Dim ColBWidth As Single
    Dim ColCWidth As Single
    Dim ColDWidth As Single
    Dim ColEWidth As Single
    Dim Row1Height As Single
    Dim Row2Height As Single
    Dim Row3Height As Single
    Dim Row4Height As Single
    Dim Row5Height As Single
    Dim FontName As String
    Dim FontSize As Integer
    Dim MaxLength As Integer
    Dim QtyCol As Integer
    Dim PMCol As Integer
   
    Dim NumSelCount As Integer
    Dim NumSelRow As Integer
    Dim NumSelCol As Integer
    Dim CurrRow As Integer
   
    Dim tmpStr As String
    Dim spcInt As Integer
    Dim tmpName As String
   
   
   ColAWidth = Sheets(1).Cells(3, 6)
   ColBWidth = Sheets(1).Cells(4, 6)
   ColCWidth = Sheets(1).Cells(5, 6)
   ColDWidth = Sheets(1).Cells(6, 6)
   ColEWidth = Sheets(1).Cells(7, 6)
    Row1Height = Sheets(1).Cells(8, 6)
    Row2Height = Sheets(1).Cells(9, 6)
    Row3Height = Sheets(1).Cells(10, 6)
    Row4Height = Sheets(1).Cells(11, 6)
    Row5Height = Sheets(1).Cells(12, 6)
    FontName = Sheets(1).Cells(13, 6)
    FontSize = Sheets(1).Cells(14, 6)
    MaxLength = Sheets(1).Cells(15, 6)
    CurrRow = 1
    Sheets(3).Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").ColumnWidth = 23
    Columns("B:B").ColumnWidth = 20
    Columns("C:C").ColumnWidth = 7
   Columns("D:D").ColumnWidth = 12
    Columns("E:E").ColumnWidth = 40
   Columns("F:F").ColumnWidth = 10
   
   
    Sheets(4).Select
    NumSelCount = Selection.Count
    NumSelRow = Selection.Row
    NumSelCol = Selection.Column
   
        For iRow = 0 To NumSelCount - 1
        If (Len(Cells(NumSelRow + iRow, NumSelCol)) > 0) Then
      '      If Len(Cells(NumSelRow + iRow, NumSelCol + 3)) + Len(Cells(NumSelRow + iRow, NumSelCol + 4)) > 50 Then
      '          MsgBox "description Length  must <=50."
       '         Exit Sub
        '    End If
        '    If Len(Cells(NumSelRow + iRow, NumSelCol + 6)) < 1 Then
        '        MsgBox "not number"
        '        Exit Sub
        '    End If
        '    If Not IsNumeric(Cells(NumSelRow + iRow, NumSelCol + 6)) Then
        '        MsgBox "not number"
        '        Exit Sub
        '    End If
         
                Sheets(3).Cells(CurrRow, 1) = UCase(Cells(NumSelRow + iRow, NumSelCol))
                Sheets(3).Cells(CurrRow, 2) = UCase(Sheets(4).Cells(1, 2))
                Sheets(3).Cells(CurrRow, 3) = UCase(Cells(NumSelRow + iRow, NumSelCol + 2))
                Sheets(3).Cells(CurrRow, 4) = UCase(Sheets(4).Cells(2, 2))
                Sheets(3).Cells(CurrRow, 5) = UCase(Cells(NumSelRow + iRow, NumSelCol - 1))
                Sheets(3).Cells(CurrRow, 6) = UCase(Cells(NumSelRow + iRow, NumSelCol + 4))
                CurrRow = CurrRow + 1
         End If
    Next
   
   
Sheets(2).Select
     Columns("A:A").Select
    Selection.ClearContents
   
   
   
'    With Selection.Font
'        .Name = FontName
'        .Size = FontSize
'        .Strikethrough = False
'        .Superscript = False
'        .Subscript = False
'        .OutlineFont = False
'        .Shadow = False
'        .Underline = xlUnderlineStyleNone
'        .ColorIndex = xlAutomatic
'    End With
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .ShrinkToFit = False
'        .MergeCells = False
'    End With
    Cells(1, 1).Select
   
    x = 1
    Do While Sheets(3).Cells(x, 1).Value <> ""

   
'   Dim lblRow As Integer
'   lblRow = 1
'   For lblNum = 1 To CurrRow - 1 Step 1
    '2
'       Rows(lblRow).RowHeight = Row1Height
'       Rows(lblRow + 1).RowHeight = Row2Height
'       Rows(lblRow + 2).RowHeight = Row3Height
'       Rows(lblRow + 3).RowHeight = Row4Height
'       Rows(lblRow + 4).RowHeight = Row2Height
'       Rows(lblRow + 5).RowHeight = Row5Height
        
        
'   Range(Cells(lblRow, 1), Cells(lblRow, 1)).Select
'    With Selection.Font
'        .Name = "C39P72DlTt"
'        .Size = 24
'        .Strikethrough = False
'        .Superscript = False
'        .Subscript = False
'        .OutlineFont = False
'        .Shadow = False
'        .Underline = xlUnderlineStyleNone
'        .ColorIndex = xlAutomatic
'    End With
     
'     Range(Cells(lblRow + 3, 1), Cells(lblRow + 3, 1)).Select
'    With Selection.Font
'        .Name = "C39P72DlTt"
       ' "C39P72DlTt" "C39HrP60DlTt"
'        .Size = 18
'        .Strikethrough = False
'        .Superscript = False
'        .Subscript = False
'        .OutlineFont = False
'        .Shadow = False
'        .Underline = xlUnderlineStyleNone
'        .ColorIndex = xlAutomatic
'    End With
        
        
       Sheets(2).Cells(6 * x - 5, 1) = "*" + Sheets(3).Cells(x, 1) + "*"
       Sheets(2).Cells(6 * x - 4, 1) = "*" + Sheets(3).Cells(x, 1) + "*" + "      " + UCase(Sheets(3).Cells(x, 3))
       Sheets(2).Cells(6 * x - 3, 1) = "【" + UCase(Sheets(3).Cells(x, 5)) + "】" + "  " + Sheets(3).Cells(x, 2)
      Sheets(2).Cells(6 * x - 2, 1) = "*" + UCase(Sheets(3).Cells(x, 4)) + "*"
     Sheets(2).Cells(6 * x - 1, 1) = "*" + UCase(Sheets(3).Cells(x, 4)) + "*" + UCase(Sheets(3).Cells(x, 6))
      x = x + 1
      Loop
      
  '  Sheets(2).Select
  '  Columns("A:A").Select
  '  Selection.ClearContents
    Range("K1:K6").Select
    Selection.Copy
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
'    Sheets(2).Columns("A:A").ColumnWidth = ColAWidth
   
'    Range("K1:K6").Select
'    Selection.Copy
'    Columns("A:A").Select
'    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
'        SkipBlanks:=False, Transpose:=False
'    Application.CutCopyMode = False

   
     Application.ActivePrinter = "\\Jacky\ZDesigner ZM400 200 dpi (ZPL) 在 Ne01:"
   
'  With ActiveSheet.PageSetup
  '      .LeftHeader = ""
  '      .CenterHeader = ""
  '      .RightHeader = ""
  '      .LeftFooter = ""
  '      .CenterFooter = ""
  '      .RightFooter = ""
  '      .LeftMargin = Application.InchesToPoints(3.93700787401575E-02)
  '      .RightMargin = Application.InchesToPoints(3.93700787401575E-02)
  '      .TopMargin = Application.InchesToPoints(3.93700787401575E-02)
  '      .BottomMargin = Application.InchesToPoints(3.93700787401575E-02)
  '      .HeaderMargin = Application.InchesToPoints(0)
  '      .FooterMargin = Application.InchesToPoints(0)
  '      .PrintHeadings = False
  '      .PrintGridlines = False
  '      .PrintComments = xlPrintNoComments
  '      .PrintQuality = 203
  '      .CenterHorizontally = False
  '      .CenterVertically = False
  '      .Orientation = xlPortrait
  '      .Draft = False
  '      .FirstPageNumber = xlAutomatic
  '      .Order = xlOverThenDown
  '      .BlackAndWhite = False
  '      .Zoom = 110
  '     .PrintErrors = xlPrintErrorsDisplayed
  '  End With
                  
End Sub
附件文件： 描述汇总1.2.rar (430.34 KB, 下载次数: 56)

2012-6-1 22:28 上传

点击文件名下载附件