第一次运行没问题，第二次报错“对象变量或WITH块变量未设置 ”，检查发现为er.Select和ActiveSheet.Paste两条语句问题，不知如何修改！

'生成条形码
Private Sub Cmd_Create_Click()

Dim path1 As String
Dim eFile As String, pFile As String
Dim ex As New Excel.Application, eb As Excel.Workbook, es As Excel.Worksheet, er As Excel.Range

''''''''''''''''''''''''''
   Dim FileNo As Integer
    Dim txtFile As String
    Dim strBmpFile As String
    Dim binBmpFile As String
    Dim xScale As Integer
    Dim yScale As Integer
    Dim bmp As String
    Dim img As String

    On Error GoTo ErrNote

    Edit_TxtFileName.Text = App.Path + "\kkkkk.txt"
    Edit_Source.Text = ""

    Call dqtext
    '将文本写入文本文件
    xScale = 1
    yScale = 1
    txtFile = ""
    If (Edit_Source.Text <> "") Then
        FileNo = FreeFile()
        txtFile = App.Path + "\TxtTemp.txt"
        Open txtFile For Output As #FileNo
        Print #FileNo, Edit_Source.Text
        Close #FileNo
    End If

    '进行图形压缩
    binBmpFile = ""
    If (Edit_ImgFileName.Text <> "") Then
        Image_Bar.Picture = LoadPicture(Edit_ImgFileName.Text)
        strBmpFile = App.Path + "\strbmpfile.bmp"
        binBmpFile = App.Path + "\binBmpFile.img"
        SavePicture Image_Bar.Picture, strBmpFile
        Call SizeDIB(binBmpFile, 100, 100)
        Call Wcompress(strBmpFile, binBmpFile, 800)
        Kill (strBmpFile)
    End If

    '设置制码参数
    If (Edit_ConFileName.Text <> "") Then
      If (m_bWorkMode) Then
        SetConFile (Edit_ConFileName.Text)
      Else
        SetQrConFile (Edit_ConFileName.Text)
      End If
    End If
    '进行条形码制作
    If (txtFile <> "" Or binBmpFile <> "") Then
        If (m_bWorkMode) Then
            strBmpFile = MakePdf417(txtFile, binBmpFile, "")
            xScale = GetPrivateProfileInt("PDF", "XScale", 1, Edit_ConFileName)
            yScale = GetPrivateProfileInt("PDF", "YScale", 1, Edit_ConFileName)
        Else
            strBmpFile = MakeQrCode(txtFile, binBmpFile, "")
            xScale = GetPrivateProfileInt("QR", "XScale", 1, Edit_ConFileName)
            yScale = xScale
        End If
        If (strBmpFile <> "") Then      '显示条码
            Image_Bar.Stretch = False
            Image_Bar.Picture = LoadPicture(strBmpFile)
            Image_Bar.Height = yScale * Image_Bar.Height
            Image_Bar.Width = xScale * Image_Bar.Width
            Image_Bar.Stretch = True
            Kill (strBmpFile)
            Cmd_Print.Enabled = True
            Cmd_Copy.Enabled = True
        Else
            MsgBox "编码失败!"
            Image_Bar.Stretch = False
            Image_Bar.Picture = LoadPicture("")
            Clipboard.Clear
            Cmd_Print.Enabled = False
            Cmd_Copy.Enabled = False
        End If
'''''''''''''''''''''''''''''''''''''

eFile = App.Path + "\test1.xls"        'Excel 文件路径
ex.Visible = True                    '可以不要
Set eb = ex.Workbooks.Open(eFile)    '打开 Excel 文件
I = 1
Set es = eb.Sheets(1)                       '文件中表格 Sheets(1)
Set er = es.Cells(5, I)                       '表格中单元 Cells(1,1)
I = I + 3

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Clipboard.Clear
    Clipboard.SetData Image_Bar.Picture, vbCFBitmap              '复制图片
    Cmd_Copy.Enabled = False
    Print vbCFBitmap
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
er.Select '移動剪貼板內容到指定位置
ActiveSheet.Paste '粘貼Application.CutCopyMode = False '取消文本周圍選定框               '粘贴图片

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

ex.ActiveWorkbook.Save
Cmd_Copy.Enabled = True
eb.Close True
ex.Quit
Set ex = Nothing
  Edit_Source.Text = ""

''''''''''''''''''''''''''''''''''''''''''''''''
    End If
    Exit Sub

ErrNote:
    MsgBox Err.Description
End Sub --------------------编程问答-------------------- 这是什么代码看得我内牛满面

补充：VB ,  基础类