永中首页 | 产品聚焦 | 销售渠道 | 服务支持 | 教育专栏 | 二次开发 | 在线订购 | 产品注册 | 免费下载 | 新闻中心 | 关于永中 | 永中未来星
发新话题
打印

闲暇时写的VBA批处理和批打印代码

闲暇时写的VBA批处理和批打印代码

Sub My_Print_1()
'
' 更新并打印“各型号出荷予实绩.XLS”中的各型号出荷予实绩
' 宏由 shuhiko 制作,时间: 2006年2月
'
'
    ChDir "[url=file://\\Sapcnsewscsrv\Public\]\\Sapcnsewscsrv\Public\[/url]製造部(Manufacture)\生产管理\生産進捗\当月生产进度"   '选择目录
    Workbooks.Open Filename:= _
        "[url=file://\\Sapcnsewscsrv\Public\]\\Sapcnsewscsrv\Public\[/url]製造部(Manufacture)\生产管理\生産進捗\当月生产进度\各型号出荷予实绩.XLS", _
        UpdateLinks:=3   '打开工作表/确认更新内容
'    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True   '修改链接数据源
'    ActiveWindow.SelectedSheets.PrintPreview
    Sheets(Array("SDPW出荷", "制造出荷", "SDPW LLCD", "LLCD制造出荷")).Select
    Sheets("SDPW出荷").Activate
    Application.ActivePrinter = "FX Document Centre C450 PCL 6 在 Ne02:"    '选择打印机
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True   '对选定的工作表进行打印
    Excel.Workbooks("各型号出荷予实绩.XLS").Close SaveChanges:=False
'    ActiveWindow.Close
    Windows("打印.xls").Activate    '当前界面切换回“打印.xls”
End Sub
Sub My_Print_2()
'
' 更新并打印“EVFハンドリング実績.xls”中符合条件的工作表
' 宏由 shuhiko 制作,时间: 2006年2月13日
'           修改,时间: 2006年3月9日
'
'

'   1、打开文档
    ChDir "[url=file://\\Sapcnsewscsrv\Public\]\\Sapcnsewscsrv\Public\[/url]製造部(Manufacture)\esp_odbc\handling_report" '选择目录
    Workbooks.Open Filename:= _
    "[url=file://\\Sapcnsewscsrv\Public\]\\Sapcnsewscsrv\Public\[/url]製造部(Manufacture)\esp_odbc\handling_report\EVFハンドリング実績.xls", _
    UpdateLinks:=3   '打开工作表
    Windows("EVFハンドリング実績.xls").Activate    ' 切换窗口到文件“EVFハンドリング実績.xls”
   
'   2、修正“EVFハンドリング実績.xls”中“059CKKB8”工作表内顶端表格右方的型号名打印不全的问题
    Sheets("059CKKB8").Activate
    Range("Z6:AG13").Select
    Selection.UnMerge   ' 取消合并单元格
    Range("Y6").Select
    ActiveCell.FormulaR1C1 = "059CKKB8"
    Sheets("059XKK1").Select
    Range("Z6:AG13").Select
    Selection.Copy  ' 选择格式刷
    Sheets("059CKKB8").Select
    Range("Y6").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False    ' 采用和其他工作表中表示型号名的文字以同样的格式
    Application.CutCopyMode = False
    Range("Y6:AG13").Select
    Selection.Merge ' 选择合适的单元格区域进行合并
        
'   3、开始进行打印操作
    Sheets("TOTAL").Select  ' 选中工作表“TOTAL”
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "=day(today())+1"  ' 昨天的日期加一,取得列号
    Dim m, n, o As Integer
    m = Range("A1").Value   ' 将A1的值赋给m
    Range("A1").Select
    Selection.ClearContents ' 清除A1中的内容,防止打印出来,这个值只是暂时利用一下
    n = 0
    o = 0
    Do While n < Worksheets.Count - 1
    n = n + 1
        If ActiveSheet.Cells(34, m).Value <> 0 Or ActiveSheet.Cells(55, m).Value <> 0 Then       ' 假如前一天的日毎実績不为零,即有入库或投入
            o = o + 1   ' 开始计数
            Application.ActivePrinter = "FX Document Centre C450 PCL 6 在 Ne02:"    '选择打印机
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True   '对选定的工作表进行打印
        End If
        ActiveWorkbook.ActiveSheet.Next.Select ' 依次对工作表进行操作
    Loop    ' 在条件内循环
    MsgBox ("一共打印了" & o & "张表格!")
'    ThisWorkbook.Saved = True   ' 不保存该Excel文档
    Excel.Workbooks("EVFハンドリング実績.xls").Close SaveChanges:=False
'    Application.Quit    ' 退出工作簿
'    ActiveWindow.Close
End Sub
Sub my_Print_3()
'
' 更新并打印“当月投入前在庫実績.xls”
' 宏由 shuhiko 制作,时间: 2006年2月
'
'
    ChDir "[url=file://\\Sapcnsewscsrv\Public\]\\Sapcnsewscsrv\Public\[/url]製造部(Manufacture)\生产管理\投入前在库\"   '选择目录
    Workbooks.Open Filename:= _
    "[url=file://\\Sapcnsewscsrv\Public\]\\Sapcnsewscsrv\Public\[/url]製造部(Manufacture)\生产管理\投入前在库\当月投入前在庫実績.xls", _
    UpdateLinks:=3   '打开工作表/确认更新内容
'    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True   '修改链接数据源
    Application.ActivePrinter = "FX Document Centre C450 PCL 6 在 Ne02:"    '选择打印机
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True   '对选定的工作表进行打印
    Excel.Workbooks("当月投入前在庫実績.xls").Close SaveChanges:=False
'    ActiveWindow.Close
    Windows("打印.xls").Activate    '当前界面切换回“打印.xls”
End Sub
Sub My_Print_4()
'
' 更新并打印“PL计划与实际.xls”
' 宏由 shuhiko 制作,时间: 2006年2月
'
'
    ChDir "[url=file://\\SAPCNSEWSCSRV\Public\]\\SAPCNSEWSCSRV\Public\[/url]共通     (Public)\製造部(Manufacture)\PL生产进度\"   '选择目录
    Workbooks.Open Filename:= _
    "[url=file://\\SAPCNSEWSCSRV\Public\]\\SAPCNSEWSCSRV\Public\[/url]共通     (Public)\製造部(Manufacture)\PL生产进度\PL计划与实际.xls", _
    UpdateLinks:=3   '打开工作表/确认更新内容
'    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True   '修改链接数据源
    Application.ActivePrinter = "FX Document Centre C450 PCL 6 在 Ne02:"    '选择打印机
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True   '对选定的工作表进行打印
    Excel.Workbooks("PL计划与实际.xls").Close SaveChanges:=False
'    ActiveWindow.Close
    Windows("打印.xls").Activate    '当前界面切换回“打印.xls”
    Excel.Workbooks("打印.xls").Close SaveChanges:=False
    Kill Application
End Sub

TOP

Private Sub myProgram_Click()
'
' myProgram 执行程序
' shuhiko ,时间: 2006-2-7
'

'
    Dim m, n
    m = 3
    n = 3
    Do While m < 40
    m = m + 1   '' 在3-40行之间从上往下遍历
    For m = 3 To Worksheets("sheet1").Rows.Count
    If Range("C" & m).Value <> "" Then  '' 假设该单元格不为空,即有内容
        Range("C" & m).Select
        If Range("C" & n).Value = "" Then   '' 查找没有内容的单元格
        Selection.Cut Destination:=Range("C" & n)
        n = n + 1   '' 逐行查找空单元格或者叫没有内容的单元格
        End If
    End If
    Next m
    Loop
    MsgBox ("Finished!")
End Sub

Private Sub myReset_Click()

'
' myRest 重置数据
' shuhiko ,时间: 2006-2-7
'

'
    Sheets("Sheet2").Select
    Sheets("Sheet2").Range("A1:G28").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
'    Sheets("Sheet2").Select
'    Range("A1:G27").Select
'    Application.CutCopyMode = False
'    Selection.Copy
'    Sheets("Sheet1").Select
'    Range("A1").Select
'    ActiveSheet.Paste
'    ActiveWindow.WindowState = xlNormal
'    ActiveWindow.WindowState = xlNormal
End Sub

TOP

发新话题