excelApp.Visible=false作用

本文介绍如何使用Visual Basic for Applications (VBA)创建一个宏,用于打开指定路径的Excel文件,并设置其为不可见状态。适用于需要自动化处理Excel文件场景。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

Set excelApp=CreateObject("excel.application")
excelApp.Workbooks.Open("D:\WORK\Testing Work - Eva\SIT\Coming Renewal Testing\Siemense  ELC - CNHBBAALL-1156\2012 Renewal\FlexPlan.xls")
excelApp.Visible=false

可以使打开的excel显示或者不显示

%% 步骤1:准备数据(示例数据,可替换为实际数据) % 生成测试数据:x为0到10的100个点,y1为正弦波,y2为余弦波 x = linspace(0, 10, 100); % 创建0到10的等间距数组 y1 = sin(x); % 正弦函数值 y2 = cos(x); % 余弦函数值 %% 步骤2:创建图形并设置属性 figure; % 创建新图形窗口 hold on; % 保持当前图形,允许多条曲线叠加 % 绘制两条曲线并设置样式 plot(x, y1, 'b-', 'LineWidth', 2); % 蓝色实线,线宽2 plot(x, y2, 'r--', 'LineWidth', 2); % 红色虚线,线宽2 % 添加图形标签和标题 xlabel('X轴数值', 'FontSize', 12); % X轴标签 ylabel('Y轴数值', 'FontSize', 12); % Y轴标签 title('正弦与余弦函数对比', 'FontSize', 14); % 图形标题 legend('sin(x)', 'cos(x)', 'Location', 'best'); % 添加图例 grid on; % 显示网格线 %% 步骤3:保存图形到临时图片文件 % 定义临时文件名(使用时间戳避免重复) tempImgName = ['temp_plot_' datestr(now, 'yyyymmdd_HHMMSS') '.png']; saveas(gcf, tempImgName); % 将当前图形保存为PNG文件 %% 步骤4:将图片插入Excel文件 excelFileName = '绘图结果.xlsx'; % 定义Excel文件名 % 创建Excel COM对象(需要安装Microsoft Excel) try excelApp = actxserver('Excel.Application'); % 启动Excel后台进程 excelApp.Visible = false; % 隐藏Excel界面 % 检查文件是否存在,不存在则创建工作簿 if ~exist(excelFileName, 'file') workbook = excelApp.Workbooks.Add(); else workbook = excelApp.Workbooks.Open([pwd '\' excelFileName]); end % 添加新工作表(命名为当前日期) sheetName = datestr(now, 'yyyy-mm-dd'); sheets = workbook.Sheets; newSheet = sheets.Add([], sheets.Item(sheets.Count)); newSheet.Name = sheetName; % 插入图片到Excel targetRange = 'B2'; % 图片插入起始位置 excelSheet = workbook.ActiveSheet; excelPictures = excelSheet.Shapes; excelPictures.AddPicture(... [pwd '\' tempImgName], ... % 图片完整路径 false, true, ... % 链接文件, 随文档保存 excelSheet.Range(targetRange).Left, ... % 水平位置 excelSheet.Range(targetRange).Top, ... % 垂直位置 400, 300); % 图片宽度和高度(单位:磅) % 在图片下方添加描述文本 excelSheet.Range('B12').Value = '图形说明:'; excelSheet.Range('B13').Value = '1. 蓝色实线: sin(x)函数曲线'; excelSheet.Range('B14').Value = '2. 红色虚线: cos(x)函数曲线'; % 保存并关闭Excel workbook.SaveAs([pwd '\' excelFileName]); workbook.Close; excelApp.Quit; % 删除临时图片文件 delete(tempImgName); disp(['成功保存到Excel文件: ' excelFileName]); catch ME disp('操作失败,错误信息:'); disp(ME.message); % 确保清理COM对象 if exist('excelApp', 'var') excelApp.Quit; delete(excelApp); end end
07-10
Dim sUrl As String '報表模組 Dim RPTKIND As String = "WIP" Dim Base_ID As String Dim Lot_ID As String Dim RECORD_ID As String Dim part_id As String Dim ver As String Dim Sql_m, sql, sql_korea, str As String Dim I As Integer Dim is_al_name As New ArrayList Dim is_al As New ArrayList Dim is_dt As New ArrayList Dim is_sql As New ArrayList Dim RPTSQL1 As String Dim RPTNAME1 As String Dim rpt_name As String Dim filename, filename2, filename3, Path As String Dim FLAG As Integer = 0 Dim log_sql As String Dim tag As String Dim sourcePath As String Dim targetPath As String Dim targetPath2 As String Dim J As Integer Dim fso As Object Dim ExcelApp As Object Dim Workbook As Excel.Workbook If MsgBox("請確認是否要列印所選擇的所有工單?", MsgBoxStyle.OkCancel, "提示") = MsgBoxResult.Cancel Then Exit Sub End If tag = CStr(DateDiff(DateInterval.Second, New DateTime(1970, 1, 1), Now())) For I = 0 To DG_MAIN.Rows.Count - 1 If DG_MAIN.Rows(I).Cells("cbox").Value = True Then Base_ID = DG_MAIN.Rows(I).Cells("BASE_ID").EditedFormattedValue.ToString Lot_ID = DG_MAIN.Rows(I).Cells("THIS_LOT_ID").EditedFormattedValue.ToString part_id = DG_MAIN.Rows(I).Cells("new_part_id").EditedFormattedValue.ToString ver = DG_MAIN.Rows(I).Cells("this_ver").EditedFormattedValue.ToString RECORD_ID = DG_MAIN.Rows(I).Cells("RECORD_ID").EditedFormattedValue.ToString is_al_name.Clear() is_al.Clear() ' 原始檔案路徑與複製後的檔案路徑 filename = part_id + ver + "_工單" sourcePath = System.Configuration.ConfigurationManager.AppSettings("Path_save").ToString() & "\Public\System\Wpaper_Data\Before\" & filename & ".xlsx" targetPath = System.Configuration.ConfigurationManager.AppSettings("Path_save").ToString() & "\Public\System\Wpaper_Data\Before\" & filename & "_" & Base_ID & Lot_ID & ".xlsx" targetPath2 = System.Configuration.ConfigurationManager.AppSettings("Path_save").ToString() & "\Public\System\Wpaper_Data\Before\" & filename & "_" & Base_ID & Lot_ID & ".PDF" If File.Exists(sourcePath) Then Else MsgBox("指定路徑下暫未找到製作規範流程文檔,請確認!") Exit Sub End If ' 建立 FileSystemObject 來複製檔案 fso = CreateObject("Scripting.FileSystemObject") fso.CopyFile(sourcePath, targetPath, True) ' True 表示覆蓋已存在的檔案 ' 建立 Excel 應用程式物件 ExcelApp = CreateObject("Excel.Application") ExcelApp.Visible = True Workbook = ExcelApp.Workbooks.Open(targetPath) ' 這裡可以加入其他操作,例如讀取儲存格資料 ' 寫入資料到第一個工作表的 A1 儲存格 ' Workbook.Sheets(1).Cells(108, 18).Value = "這是寫入的資料" ' 寫入條碼文字(Code 39 需加 * 符號) Workbook.Sheets(1).Cells(109, 1).Value = "*" & Workbook.Sheets(1).Cells(108, 1).Value & "*" Workbook.Sheets(1).Cells(109, 7).Value = "*" & Base_ID & "*" Workbook.Sheets(1).Cells(109, 14).Value = "*" & Lot_ID & "*" Workbook.Sheets(1).Cells(109, 18).Value = "*" & Workbook.Sheets(1).Cells(108, 18).Value & "*" ' 設定字型為條碼字型(需已安裝) Workbook.Sheets(1).Cells(109, 1).Font.Name = "3 of 9 Barcode" Workbook.Sheets(1).Cells(109, 7).Font.Name = "3 of 9 Barcode" Workbook.Sheets(1).Cells(109, 14).Font.Name = "3 of 9 Barcode" Workbook.Sheets(1).Cells(109, 18).Font.Name = "3 of 9 Barcode" J = 110 For J = 120 To 150 If InStr(Workbook.Sheets(1).Cells(J, 5).Value, "Program:.") > 0 Then Workbook.Sheets(1).Cells(J, 20).Value = "*" & Mid(Workbook.Sheets(1).Cells(J, 5).Value, InStr(Workbook.Sheets(1).Cells(J, 5).Value, "Program:.") + 7, 10) & "*" Workbook.Sheets(1).Cells(J, 20).Font.Name = "3 of 9 Barcode" End If Next '轉成PDF 'Workbook.ExportAsFixedFormat(Type:=0, filename:=targetPath2, Quality:=0, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False) ' 儲存並關閉 Workbook.Save() ' 不關閉 Excel,讓使用者操作 Workbook = Nothing ExcelApp = Nothing fso = Nothing End If Next End Sub1. 加一個預覽工單的功能 2.配合勾選將工單Excel 產出對應的Excel 3.在各層別的背面工單加入 料號+生產工單+4碼工令+層別 的條碼 4.每一面次的背面工單都是由108行*面次~108行*面次+106 行 4.在背面工單判斷NOTE 欄位(E欄位),若有Program:.程式代號 ,關鍵字Program:.則在該欄位加入 條碼=*料號+程式代號 * 5.存成PDF後產出,利用網頁打開或是直接打開Excel(再討論)這樣就可以進行預覽列印
最新发布
07-25
'------------------------------------------------------------------+ ' Module specification '------------------------------------------------------------------+ ' ' Module Name : CompareWorksheets ' ' Copyright : Yokogawa SCE, 2004 ' ' Author : Jan Worst ' ' Description : Compare Worksheets ' '------------------------------------------------------------------+ ' Changes .... '------------------------------------------------------------------+ ' Who When Change What '------------------------------------------------------------------+ ' WST Jun-04 exxxx FAST/TOOLS to Excel demo '------------------------------------------------------------------+ ' ' Compare Worksheets ws1 and ws2' Place results in ws1 ' ws1 and ws2 must both contain table key (column "NAME") Public Const CLR_FONT_DIFFERS = 3 ' red Public Const CLR_FILL_DIFFERS = 40 ' light red Public Const CLR_FILL_EXCEL_ONLY = 36 ' light yellow Public Const CLR_FILL_FT_ONLY = 37 ' light blue Public Const CLR_FONT_NOT_IN_WS2 = 48 ' gray Option Explicit Public Sub CompareWorksheets( _ ws1 As Worksheet, ws1Name As String, _ ws2 As Worksheet, ws2Name As String) ' Debug.Print "qldCompareWorksheets - ws1=" & ws1.Name & ", ws2 = " & ws2.Name; "" Dim rowWs1 As Long Dim rowWs2 As Long ' Dim row As Long Dim colWs1 As Long Dim colWs2 As Long Dim ws1ColCount As Integer ' ws1 column count Dim ws2ColCount As Integer ' ws2 column count Dim ws1ColComment As Integer ' ws1 Comment column Dim ws2ColComment As Integer ' ws2 Comment column ' Dim ws1ColName As Integer ' column containing key (field "NAME") ' Dim ws2ColName As Integer ' column containing key (field "NAME") ' Dim ws1RowCount As Long 'Dim ws2RowCount As Long Dim ws1Keys(1 To 66000) As String Dim ws2Keys(1 To 66000) As String Dim CountUnequal As Long Dim countOnlyWs1 As Long Dim countOnlyWs2 As Long Dim ws1RowHeader As Long Dim ws2RowHeader As Long Dim ws1RowFirst As Long Dim ws2RowFirst As Long Dim ws1RowLast As Long Dim ws2RowLast As Long Dim qldWS1 As New qldWorkSheet qldWS1.Initialize ws1 ws1ColCount = qldWS1.ColumnCount ws1RowHeader = qldWS1.RowDataHeader ws1RowFirst = qldWS1.RowDataFirst ws1RowLast = qldWS1.RowDataLast Dim qldWS2 As New qldWorkSheet qldWS2.Initialize ws2 ws2ColCount = qldWS2.ColumnCount ws2RowHeader = qldWS2.RowDataHeader ws2RowFirst = qldWS2.RowDataFirst ws2RowLast = qldWS2.RowDataLast '------------------------------------------------------ ' Fill key array ws1 and ws2 '------------------------------------------------------ If FillKeyArray(ws1Keys, qldWS1, ws1ColComment) = False Then Exit Sub If FillKeyArray(ws2Keys, qldWS2, ws2ColComment) = False Then Exit Sub '------------------------------------------------------ ' Compare all cells in Excel with FT table '------------------------------------------------------ Dim ColFound As Boolean Dim KeyFound As Boolean Dim Equal As Boolean ' Dim Key As String For rowWs1 = ws1RowFirst To ws1RowLast ' Debug.Print rowWs1 & " " & ws1.Cells(rowWs1, ws1ColName) ' Find row in temporary sheet KeyFound = False ' Key = ws1.Cells(rowWs1, ws1ColName) For rowWs2 = ws2RowFirst To ws2RowLast If ws1Keys(rowWs1) = ws2Keys(rowWs2) Then KeyFound = True ' Debug.Print "Found : " & rowWs1 & " " & ws1.Cells(rowWs1, ws1ColName) ' Compare cells Equal = True For colWs1 = 1 To ws1ColCount ColFound = False For colWs2 = 1 To ws2ColCount If ws1.Cells(ws1RowHeader, colWs1) = ws2.Cells(ws1RowHeader, colWs2) Then If ws1.Cells(rowWs1, colWs1) <> ws2.Cells(rowWs2, colWs2) Then On Error Resume Next ' Ignore existing comment ws1.Cells(rowWs1, colWs1).ClearComments ws1.Cells(rowWs1, colWs1).AddComment On Error GoTo 0 With ws1.Cells(rowWs1, colWs1).Comment .Text Text:=ws2Name & ": " & ws2.Cells(rowWs2, colWs2) .Visible = False .Shape.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft .Shape.ScaleWidth 4, msoFalse, msoScaleFromTopLeft End With ws1.Cells(rowWs1, colWs1).Font.ColorIndex = CLR_FONT_DIFFERS ws1.Cells(rowWs1, colWs1).Font.Bold = True Equal = False CountUnequal = CountUnequal + 1 End If ColFound = True Exit For End If Next colWs2 If ColFound = False Then ' Column not found in ws2 ws1.Cells(rowWs1, colWs1).Font.ColorIndex = CLR_FONT_NOT_IN_WS2 End If Next colWs1 If Not Equal Then For colWs1 = 1 To ws1ColCount ws1.Cells(rowWs1, colWs1).Interior.ColorIndex = CLR_FILL_DIFFERS Next colWs1 End If End If If KeyFound Then Exit For Next rowWs2 If Not KeyFound Then For colWs1 = 1 To ws1ColCount ws1.Cells(rowWs1, colWs1).Interior.ColorIndex = CLR_FILL_EXCEL_ONLY Next colWs1 ws1.Cells(rowWs1, ws1ColComment).AddComment With ws1.Cells(rowWs1, ws1ColComment).Comment ' .Text Text:="Record not in FAST/TOOLS table" .Text Text:="Record not in " & ws2Name .Visible = False .Shape.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft .Shape.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft End With countOnlyWs1 = countOnlyWs1 + 1 End If Next rowWs1 '------------------------------------------------------ ' Add all records that only exist in FT/ws2 to compare sheet ws1 '------------------------------------------------------ For rowWs2 = ws2RowFirst To ws2RowLast KeyFound = False For rowWs1 = ws1RowFirst To ws1RowLast If ws2Keys(rowWs2) = ws1Keys(rowWs1) Then KeyFound = True Exit For End If Next rowWs1 If Not KeyFound Then countOnlyWs2 = countOnlyWs2 + 1 ' Append row ws2 to ws1 For colWs1 = 1 To ws1ColCount ws1.Cells(ws1RowLast + countOnlyWs2, colWs1) = ws2.Cells(rowWs2, colWs1) ' ws1.Cells(ws1RowLast + countOnlyWs2, colWs1).Errors.Item(xlNumberAsText).Ignore = True ws1.Cells(ws1RowLast + countOnlyWs2, colWs1).Interior.ColorIndex = CLR_FILL_FT_ONLY Next colWs1 ws1.Cells(ws1RowLast + countOnlyWs2, ws1ColComment).AddComment With ws1.Cells(ws1RowLast + countOnlyWs2, ws1ColComment).Comment .Text Text:="Record not in " & ws1Name .Visible = False .Shape.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft .Shape.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft End With End If Next rowWs2 '------------------------------------------------------ ' Report differences '------------------------------------------------------ Dim s As String If CountUnequal + countOnlyWs1 + countOnlyWs2 = 0 Then s = "Excel and FAST/TOOLS table are equal" Else s = "" If CountUnequal Then s = s & CountUnequal & " records not equal " & vbCrLf If countOnlyWs1 Then s = s & countOnlyWs1 & " records in " & ws1Name & " only" & vbCrLf If countOnlyWs2 Then s = s & countOnlyWs2 & " records in " & ws2Name & " only " & vbCrLf End If MsgBox s, vbInformation, "Differences" Set qldWS1 = Nothing Set qldWS2 = Nothing End Sub '-------------------------------------------------------------------- ' ' Fill key array with "NAME" field, or with INSTALL/UNIT/TAG fields ' ' Returns column where "compare-comment " should be written '-------------------------------------------------------------------- Private Function FillKeyArray( _ wsKeys() As String, _ qldws As qldWorkSheet, _ ByRef ColComment As Integer) As Boolean Dim ColName As Integer Dim ws As Worksheet '------------------------------------------ ' Find columns containing key fields '------------------------------------------ Set ws = qldws.Worksheet ColName = qldws.ColFieldName("NAME") '------------------------------------------ ' Find columns containing key fields '------------------------------------------ If ColName > 0 Then ColComment = ColName Else Select Case qldws.DatasetName Case "INSTALL_DF": ColComment = qldws.ColFieldName("INSTALL") Case "UNIT_DF": ColComment = qldws.ColFieldName("UNIT") Case "ITEM_DF", "ITEM_VAL", "OBJECT_DF": ColComment = qldws.ColFieldName("TAG") Case "SUB_ITEM_DF": ColComment = qldws.ColFieldName("SUB") Case "ITEM_HIS_DF": ColComment = qldws.ColFieldName("TAG") Case Else MsgBox "column NAME missing", vbExclamation Exit Function End Select End If '------------------------------------------ ' Fill keys string array '------------------------------------------ Dim Row As Long FillKeyArray = False ' assume error For Row = qldws.RowDataFirst To qldws.RowDataLast wsKeys(Row) = qldws.getKeyValue(Row) Next Row FillKeyArray = True Exit Function KeyError: MsgBox Err.Number & ": " & Err.Description, vbCritical FillKeyArray = False End Function 用VS编写C#程序
05-17
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值