Option Strict Off Imports Microsoft.Office.Interop.Excel.XlUnderlineStyle Imports Microsoft.Office.Interop.Excel.Constants Imports Microsoft.Office.Interop.Excel.XlBordersIndex Imports Microsoft.Office.Interop.Excel.XlLineStyle Imports Microsoft.Office.Interop.Excel.XlBorderWeight Imports Microsoft.Office.Interop.Excel.XlThemeFont Imports Microsoft.Office.Interop.Excel.XlThemeColor Imports Microsoft.Office.Interop.Excel.XlWindowState Imports Microsoft.Office.Interop.Excel Imports System.IO Imports Telerik.Windows.Documents.Fixed Imports System.Text.RegularExpressions Imports Telerik.WinControls.VirtualKeyboard Public Class 文件 Dim xlApp As Microsoft.Office.Interop.Excel.Application Dim xlBook As Microsoft.Office.Interop.Excel.Workbook Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet Dim 位置1 As String : Dim 已處理字串 As String Dim N2 As Integer : Dim N3 As Integer ReadOnly ds As New DataSet : ReadOnly ds1 As New DataSet : ReadOnly ds2 As New DataSet Dim 圖片資料庫指定, WW(14), WA(14) As String Dim DGVX As Integer Private Sub 文件_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.MdiParent = GRAMS_SYS : Me.WindowState = 2 : Me.AutoScroll = True RadPdfViewerNavigator1.OpenButton.Visibility = Telerik.WinControls.ElementVisibility.Collapsed RadPdfViewerNavigator1.SaveButton.Visibility = Telerik.WinControls.ElementVisibility.Collapsed PDF_P.BringToFront() 已核准的營運成本收支單_rb.Checked = True 作廢的營運成本收支單_rb.Checked = False Set_清單1() : Set_清單3() 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = False : 列印_bt.Enabled = False : 發行_bt.Enabled = False : 指定人員_bt.Enabled = False End Sub Private Sub 文件_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown SQL_圖片資料庫查詢() : If dr.Read() Then : 圖片資料庫指定 = dr("圖片資料庫") : Else : MsgBox("圖片資料庫已滿，請聯繫系統管理員!!!") : Me.Close() : End If End Sub Private Sub Set_清單3() Dim ds As New DataSet 人員1_dgv.DataSource = Nothing : ds.Clear() 人員1_dgv.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.EnableResizing 人員1_dgv.ColumnHeadersHeight = 25 人員1_dgv.AllowUserToAddRows = False SQL_通用_人員清單() da.Fill(ds) : 人員1_dgv.DataSource = ds.Tables(0) : conn.Close() Dim chkColumn As New DataGridViewCheckBoxColumn() End Sub Private Sub Set_清單1() 控制表_dgv.DataSource = Nothing : ds1.Clear() 控制表_dgv.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.EnableResizing 控制表_dgv.ColumnHeadersHeight = 25 控制表_dgv.AllowUserToAddRows = False 控制表_dgv.RowTemplate.Height = 30 If conn.State = ConnectionState.Closed Then : conn.ConnectionString = ConString : conn.Open() : End If If 作廢的營運成本收支單_rb.Checked = True And 已核准的營運成本收支單_rb.Checked = False And 已發行的營運成本收支單_rb.Checked = False Then SQL_通用_控制表清單1() ElseIf 作廢的營運成本收支單_rb.Checked = False And 已核准的營運成本收支單_rb.Checked = True And 已發行的營運成本收支單_rb.Checked = False Then SQL_通用_控制表清單() ElseIf 作廢的營運成本收支單_rb.Checked = False And 已核准的營運成本收支單_rb.Checked = False And 已發行的營運成本收支單_rb.Checked = True Then SQL_通用_控制表清單2() End If da.Fill(ds1) : 控制表_dgv.DataSource = ds1.Tables(0) : conn.Close() 控制表_dgv.Columns(0).Visible = False : 控制表_dgv.Columns(1).FillWeight = 60 : 控制表_dgv.Columns(2).Visible = False 控制表_dgv.Columns(3).Visible = False : 控制表_dgv.Columns(4).Visible = False : 控制表_dgv.Columns(5).Visible = False 控制表_dgv.Columns(6).Visible = False : 控制表_dgv.Columns(7).Visible = False : 控制表_dgv.Columns(8).Visible = False 控制表_dgv.Columns(9).Visible = False : 控制表_dgv.Columns(10).Visible = False End Sub Private Sub Set_清單2() 人員_dgv.DataSource = Nothing : ds2.Clear() 人員_dgv.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.EnableResizing 人員_dgv.ColumnHeadersHeight = 25 人員_dgv.AllowUserToAddRows = False 人員_dgv.RowTemplate.Height = 50 If conn.State = ConnectionState.Closed Then : conn.ConnectionString = ConString : conn.Open() : End If SQL_通用_明細表讀取() da.Fill(ds2) : 人員_dgv.DataSource = ds2.Tables(0) : conn.Close() 人員_dgv.Columns(0).Visible = False : 人員_dgv.Columns(1).FillWeight = 20 : 人員_dgv.Columns(2).Visible = False 人員_dgv.Columns(3).Visible = False : 人員_dgv.Columns(4).FillWeight = 50 : 人員_dgv.Columns(5).FillWeight = 30 Dim imgColumn As DataGridViewImageColumn = TryCast(人員_dgv.Columns("圖片"), DataGridViewImageColumn) If imgColumn IsNot Nothing Then imgColumn.ImageLayout = DataGridViewImageCellLayout.Zoom End If Dim transparentImage As New Bitmap(50, 50) ' Adjust size as needed Using g As Graphics = Graphics.FromImage(transparentImage) g.Clear(Color.Transparent) End Using For i As Integer = 0 To 人員_dgv.Rows.Count - 1 If 人員_dgv.Rows(i).Cells("圖片資料庫").Value.ToString <> "" And 人員_dgv.Rows(i).Cells("圖片流水號").Value.ToString <> "" Then 圖片庫 = 人員_dgv.Rows(i).Cells("圖片資料庫").Value.ToString SQL_連線字串_圖片資料庫() PA2 = 人員_dgv.Rows(i).Cells("圖片流水號").Value.ToString SQL_簽名圖() While dr.Read() = True Dim unused As Byte() = New Byte(-1) {} : Dim bytes As Byte() = DirectCast(dr.Item("圖片"), Byte()) Dim oStream As New MemoryStream(bytes) : 人員_dgv.Rows(i).Cells("圖片").Value = Bitmap.FromStream(oStream) End While : conn.Close() Else ' Set empty value if no image is available 人員_dgv.Rows(i).Cells("圖片").Value = transparentImage End If Next End Sub Private Sub 控制表_dgv_CellClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles 控制表_dgv.CellClick If e.RowIndex = -1 Then : Else 單號_tb.Text = 控制表_dgv(2, e.RowIndex).Value.ToString Dim dateString As String = 控制表_dgv(0, e.RowIndex).Value.ToString Dim dateParts() As String = dateString.Split("/"c) Dim year As Integer = Integer.Parse(dateParts(0)) + 1911 ' 將民國年轉換為西元年 Dim month As Integer = Integer.Parse(dateParts(1)) Dim day As Integer = Integer.Parse(dateParts(2)) Dim dateTime As New DateTime(year, month, day) 選擇日期_dtp.Value = dateTime 選擇日期_dtp.CustomFormat = "yyyy/MM/dd" 選擇日期_dtp.Format = DateTimePickerFormat.Custom 檔案名稱_tb.Text = 控制表_dgv(1, e.RowIndex).Value.ToString 主旨_tb.Text = 控制表_dgv(3, e.RowIndex).Value.ToString 說明_tb.Text = 控制表_dgv(4, e.RowIndex).Value.ToString 開單人_tb.Text = 控制表_dgv("開單人", e.RowIndex).Value.ToString 全選_cb.Checked = 控制表_dgv("全選", e.RowIndex).Value 圖片庫_tb.Text = 控制表_dgv("圖片庫", e.RowIndex).Value.ToString PA57 = 單號_tb.Text Set_清單2() If (全選_cb.Checked = True) Then For I As Integer = 0 To 人員1_dgv.Rows.Count - 1 Dim skip As Boolean = False ' 用于标记是否跳过当前外层循环 For II As Integer = 0 To 人員_dgv.Rows.Count - 1 If 人員1_dgv.Rows(I).Cells("姓名").Value.ToString() = 人員_dgv.Rows(II).Cells("姓名").Value.ToString() Then skip = True ' 标记跳过当前外层循环 Exit For ' 跳出内层循环 End If Next If skip Then Continue For ' 跳过当前外层循环的当前迭代 End If PA58 = 人員1_dgv.Rows(I).Cells("姓名").Value.ToString() SQL_通用_明細表新增() Next Set_清單2() End If 刪除_bt.Enabled = True : 儲存_bt.Enabled = True : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 發行_bt.Enabled = True : 指定人員_bt.Enabled = True PA1 = 單號_tb.Text : 圖片_pb.Image = Nothing : 圖片1_pb.Image = Nothing : Set_文件圖片() End If End Sub Private Sub 查詢_tb_Click(sender As Object, e As EventArgs) Handles 查詢_tb.Click PA56 = InputBox("請輸入要查詢的單號資料。") : Set_清單1() : PA56 = "" End Sub Private Sub 檔案名稱_tb_KeyPress(sender As Object, e As KeyPressEventArgs) Handles 檔案名稱_tb.KeyPress ' 允许字母、数字和空格，禁止其他字符 If Not Char.IsLetterOrDigit(e.KeyChar) AndAlso Not Char.IsWhiteSpace(e.KeyChar) Then e.Handled = True End If End Sub Private Sub 新增_bt_Click(sender As Object, e As EventArgs) Handles 新增_bt.Click 單號_tb.Text = "" : 檔案名稱_tb.Text = "" : 主旨_tb.Text = "" : 說明_tb.Text = "" : 開單人_tb.Text = gUserName : 全選_cb.Checked = False Dim NUM1 As Integer Dim dat1 As String 選擇日期_dtp.Value = DateTime.Now Dim selectedDate As DateTime = 選擇日期_dtp.Value Dim taiwanYear As Integer = selectedDate.Year - 1911 Dim str As String = String.Format("{0}{1:00}{2:00}", taiwanYear, selectedDate.Month, selectedDate.Day) PA1 = String.Format("{0}/{1:00}/{2:00}", taiwanYear, selectedDate.Month, selectedDate.Day) SQL_通用_查詢第一筆單號() If dr.Read() Then : 單號_tb.Text = dr("流水號").ToString : Else : 單號_tb.Text = str & "00" : End If dat1 = 單號_tb.Text.Substring(0, 7) If dat1 <> str Then : NUM1 = 1 : Else : NUM1 = Double.Parse(單號_tb.Text.Substring(7, 2)) + 1 : End If If NUM1 < 10 Then : 單號_tb.Text = str & "0" & NUM1 ElseIf NUM1 > 9 Then : 單號_tb.Text = str & NUM1 End If PA = 單號_tb.Text PA10 = 圖片資料庫指定 SQL_通用_新增一筆公函控制表() : conn.Close() PA57 = "" : Set_清單2() 刪除_bt.Enabled = True : 儲存_bt.Enabled = True : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 發行_bt.Enabled = True : 指定人員_bt.Enabled = True 'ComboBox1.SelectedIndex = 2 'ComboBox2.SelectedIndex = 3 'ComboBox3.SelectedIndex = 7 'ComboBox4.SelectedIndex = 8 End Sub Private Sub 刪除_bt_Click(sender As Object, e As EventArgs) Handles 刪除_bt.Click If 單號_tb.Text = "" Then : MsgBox("請先選擇文件檔案名稱!!") : Else Dim result As DialogResult = MsgBox("是否要刪除該筆資料?", MessageBoxButtons.OKCancel) If result = DialogResult.OK Then : 圖片庫 = 圖片庫_tb.Text : SQL_連線字串_圖片資料庫() : SQL_文件圖片刪除() PA57 = 單號_tb.Text : SQL_通用_明細表刪除() SQL_通用_控制表刪除(單號_tb.Text) : conn.Close() : MsgBox("刪除成功!!") 單號_tb.Text = "" : 檔案名稱_tb.Text = "" : 主旨_tb.Text = "" : 說明_tb.Text = "" : 開單人_tb.Text = "" Set_清單1() : Set_清單2() Set_文件圖片() : 圖片_pb.Image = Nothing : 圖片1_pb.Image = Nothing 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = False : 列印_bt.Enabled = False : 發行_bt.Enabled = False : 指定人員_bt.Enabled = False End If End If End Sub Private Sub 儲存_bt_Click(sender As Object, e As EventArgs) Handles 儲存_bt.Click PA57 = 單號_tb.Text If (全選_cb.Checked = True) Then If 人員1_dgv.Rows.Count < 1 Then For I As Integer = 0 To 人員1_dgv.Rows.Count - 1 PA58 = 人員1_dgv.Rows(I).Cells("姓名").Value.ToString() SQL_通用_明細表新增() Next Else For I As Integer = 0 To 人員1_dgv.Rows.Count - 1 Dim skip As Boolean = False ' 用于标记是否跳过当前外层循环 For II As Integer = 0 To 人員_dgv.Rows.Count - 1 If 人員1_dgv.Rows(I).Cells("姓名").Value.ToString() = 人員_dgv.Rows(II).Cells("姓名").Value.ToString() Then skip = True ' 标记跳过当前外层循环 Exit For ' 跳出内层循环 End If Next If skip Then Continue For ' 跳过当前外层循环的当前迭代 End If PA58 = 人員1_dgv.Rows(I).Cells("姓名").Value.ToString() SQL_通用_明細表新增() Next End If End If SQL_通用_控制表修改(檔案名稱_tb.Text, 主旨_tb.Text, 說明_tb.Text, 單號_tb.Text, 全選_cb.Checked) : conn.Close() : MsgBox("儲存成功!!") : Set_清單1() : Set_清單2() 'If 開單人_tb.Text = gUserName Or 登入人級別 = "00" Then ' SQL_通用_控制表修改(檔案名稱_tb.Text, 主旨_tb.Text, 說明_rtb.Text, 單號_tb.Text) : conn.Close() : MsgBox("儲存成功!!") : Set_清單1() ' If 登入人級別 <> "00" Then ' 刪除_bt.Enabled = True : 儲存_bt.Enabled = True : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 新增_bt.Enabled = True ' End If 'Else ' MsgBox("請確認開單人是否為本人") 'End If End Sub Private Sub 發行_bt_Click(sender As Object, e As EventArgs) Handles 發行_bt.Click SQL_通用_控制表發行(單號_tb.Text) : conn.Close() : MsgBox("發行成功!!") : Set_清單1() End Sub Private Sub 作廢_bt_Click(sender As Object, e As EventArgs) Handles 作廢_bt.Click SQL_通用_控制表作廢(單號_tb.Text) : conn.Close() : MsgBox("作廢成功!!") : Set_清單1() End Sub Private Sub 編輯人員_bt_Click(sender As Object, e As EventArgs) Handles 指定人員_bt.Click 全選_cb.Checked = False PA57 = 單號_tb.Text : 選擇人員.ShowDialog() : Set_清單2() End Sub Private Sub 作廢的營運成本收支單_rb_CheckedChanged(sender As Object, e As EventArgs) Handles 作廢的營運成本收支單_rb.Click 作廢的營運成本收支單_rb.Checked = True : 已核准的營運成本收支單_rb.Checked = False : 已發行的營運成本收支單_rb.Checked = False Set_清單1() End Sub Private Sub 已核准的營運成本收支單_rb_CheckedChanged(sender As Object, e As EventArgs) Handles 已核准的營運成本收支單_rb.Click 作廢的營運成本收支單_rb.Checked = False : 已核准的營運成本收支單_rb.Checked = True : 已發行的營運成本收支單_rb.Checked = False Set_清單1() End Sub Private Sub 已發行的營運成本收支單_rb_CheckedChanged(sender As Object, e As EventArgs) Handles 已發行的營運成本收支單_rb.Click 作廢的營運成本收支單_rb.Checked = False : 已核准的營運成本收支單_rb.Checked = False : 已發行的營運成本收支單_rb.Checked = True Set_清單1() End Sub Private Sub 圖片清單_dgv_CellClick(ByVal sender As System.Object, ByVal e As DataGridViewCellEventArgs) Handles 圖片清單_dgv.CellClick If e.RowIndex = -1 Then : Else : DGVX = e.RowIndex : 圖片清單讀取() : End If End Sub Private Sub 物料圖_pb_Click(sender As Object, e As EventArgs) Handles 圖片_pb.Click If IsNothing(圖片_pb.Image) = False Then If 圖片清單_dgv.Rows(DGVX).Cells("File.").Value.ToString = "JPG" Then 圖片傳遞 = 圖片_pb.Image : 圖片放大視窗.ShowDialog() Else If 版本號 = "2024050101" Or 版本號 = "2024042801" Then : MsgBox("該版本尚未開放開啟PDF，預計下個版本改板後開放(下個版本將變更成需要安裝的版本)!!") : Else PA1 = 單號_tb.Text : 圖片庫 = 圖片庫_tb.Text : PA2 = 圖片清單_dgv.Rows(DGVX).Cells("Item").Value : SQL_連線字串_圖片資料庫() Dim Str As String = System.Windows.Forms.Application.StartupPath : Dim ds1 As New DataSet : ds1.Clear() : SQL_文件圖片讀取1() : da.Fill(ds1) If ds1.Tables(0).Rows.Count > 0 Then Dim imgData() As Byte : imgData = ds1.Tables(0).Rows(0).Item("圖片") Dim fs As FileStream : fs = File.Create(Str + "\" & PA2 & ".pdf", imgData.Length - 1) fs.Write(imgData, 0, imgData.Length - 1) : fs.Close() End If : conn.Close() : PDF路徑 = Str + "\" & PA2 & ".pdf" : PDF預覽.ShowDialog() End If End If End If End Sub Private Sub 圖檔入系統_rbt_Click(sender As Object, e As EventArgs) Handles 圖檔入系統_rbt.Click If 單號_tb.Text = "" Then : MsgBox("請先選擇會議/專案項目!!") : Else PA1 = 單號_tb.Text : 圖片庫 = 圖片庫_tb.Text : SQL_連線字串_圖片資料庫() For i As Integer = 0 To NU1 If WW(i) = "" Then : Else Dim 文件號 As String : Dim 文件編號 As Integer : SQL_文件圖片最後一筆編號查詢() If dr.Read() Then : 文件編號 = Double.Parse(Strings.Right(dr("項次").ToString, 2)) : Else : 文件編號 = 0 : End If conn.Close() : 文件編號 += 1 If 文件編號 < 10 Then : 文件號 = "IM" & "0" & 文件編號 ElseIf 文件編號 > 9 Then : 文件號 = "IM" & 文件編號 : End If PA2 = 文件號 : PA49 = WW(i) : PA3 = WA(i) : SQL_文件圖片入系統() End If Next For i As Integer = 0 To 5 : WW(i) = "" : Dim 選擇 As PictureBox = CType(Me.Controls.Find("PB" & i + 1, True)(0), PictureBox) : 選擇.Image = Nothing : Next Set_文件圖片() : MsgBox("上傳完畢!!") End If End Sub Private Sub Set_文件圖片() Dim ds6 As New DataSet : 圖片清單_dgv.DataSource = Nothing : ds6.Clear() 圖片清單_dgv.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.EnableResizing 圖片清單_dgv.ColumnHeadersHeight = 25 : 圖片清單_dgv.AllowUserToAddRows = False If 圖片庫_tb.Text = "" Then : 圖片庫 = 圖片資料庫指定 : Else : 圖片庫 = 圖片庫_tb.Text : End If SQL_連線字串_圖片資料庫() : SQL_文件圖片() da.Fill(ds6) : 圖片清單_dgv.DataSource = ds6.Tables(0) : conn.Close() 圖片清單_dgv.Columns(0).ReadOnly = True If 圖片清單_dgv.Rows.Count > 0 Then : DGVX = 0 : 圖片清單讀取() : Else 圖片_pb.Image = Nothing : 圖片1_pb.Image = Nothing : 圖片_P.BringToFront() 圖片1_pb.Image = My.Resources.無檔案 : 圖片_pb.SizeMode = 4 End If End Sub Private Sub 圖片清單讀取() 圖片_pb.Image = Nothing : 圖片1_pb.Image = Nothing : PA1 = 單號_tb.Text : 圖片庫 = 圖片庫_tb.Text : SQL_連線字串_圖片資料庫() PA2 = 圖片清單_dgv.Rows(DGVX).Cells("Item").Value If 圖片清單_dgv.Rows(DGVX).Cells("File.").Value.ToString = "JPG" Then : 圖片_P.BringToFront() SQL_文件圖片讀取() While dr.Read() = True Dim unused As Byte() = New Byte(-1) {} Dim bytes As Byte() = DirectCast(dr.Item("圖片"), Byte()) Dim oStream As New MemoryStream(bytes) 圖片_pb.Image = Bitmap.FromStream(oStream) 圖片1_pb.Image = Bitmap.FromStream(oStream) End While : conn.Close() : 圖片_pb.SizeMode = 4 : 圖片1_pb.SizeMode = 4 ElseIf 圖片清單_dgv.Rows(DGVX).Cells("File.").Value.ToString <> "JPG" Then : PDF_P.BringToFront() 圖片_pb.Image = My.Resources.PDF : 圖片_pb.SizeMode = 4 PA1 = 單號_tb.Text : 圖片庫 = 圖片庫_tb.Text : PA2 = 圖片清單_dgv.Rows(DGVX).Cells("Item").Value : SQL_連線字串_圖片資料庫() Dim Str As String = System.Windows.Forms.Application.StartupPath : Dim ds1 As New DataSet : ds1.Clear() : SQL_文件圖片讀取1() : da.Fill(ds1) If ds1.Tables(0).Rows.Count > 0 Then Dim imgData() As Byte : imgData = ds1.Tables(0).Rows(0).Item("圖片") Dim fs As FileStream : fs = File.Create(Str + "\" & PA2 & ".pdf", imgData.Length - 1) fs.Write(imgData, 0, imgData.Length - 1) : fs.Close() End If : conn.Close() : PDF路徑 = Str + "\" & PA2 & ".pdf" : Me.RadPdfViewer1.LoadDocument(PDF路徑) End If End Sub Private Sub 讀取資料夾路徑_rbt_Click(sender As Object, e As EventArgs) Handles 讀取資料夾路徑_rbt.Click If OpenFileDialog1.ShowDialog <> DialogResult.Cancel Then If OpenFileDialog1.FileNames.Length > 6 Then : MsgBox("選取檔案不能超過6個!!") : Else For i As Integer = 0 To 5 : WW(i) = "" : WA(i) = "" : Dim 選擇 As PictureBox = CType(Me.Controls.Find("PB" & i + 1, True)(0), PictureBox) : 選擇.Image = Nothing : Next NU1 = OpenFileDialog1.FileNames.Length - 1 For i As Integer = 0 To OpenFileDialog1.FileNames.Length - 1 : WW(i) = OpenFileDialog1.FileNames(i) : Next For i As Integer = 0 To NU1 Dim 驗證 As String = "" : Dim 取變數 As String : 取變數 = Strings.StrReverse(WW(i)) For ii As Integer = 1 To 10 If ii = 1 Then : 驗證 = Strings.Left(取變數, ii) : Else If Strings.Mid(取變數, ii, 1) = "." Then : 驗證 = Strings.StrReverse(驗證) : Exit For : Else : 驗證 &= Strings.Mid(取變數, ii, 1) : End If End If Next If 驗證 = "PNG" Or 驗證 = "png" Or 驗證 = "GIF" Or 驗證 = "gif" Or 驗證 = "BMP" Or 驗證 = "bmp" Or 驗證 = "JPG" Or 驗證 = "jpg" Or 驗證 = "JPEG" Or 驗證 = "jpeg" Then : WA(i) = "JPG" Dim 選擇 As PictureBox = CType(Me.Controls.Find("PB" & i + 1, True)(0), PictureBox) : 選擇.Image = Image.FromFile(WW(i)) : 選擇.SizeMode = 4 ElseIf 驗證 = "PDF" Or 驗證 = "pdf" Then : WA(i) = "PDF" Dim 選擇 As PictureBox = CType(Me.Controls.Find("PB" & i + 1, True)(0), PictureBox) : 選擇.Image = My.Resources.PDF : 選擇.SizeMode = 4 Else : WW(i) = "" : WA(i) = "" : End If Next End If End If End Sub Private Sub 查詢_tb_MouseEnter(sender As Object, e As EventArgs) Handles 查詢_tb.MouseEnter ToolTip1.SetToolTip(Me.查詢_tb, "關鍵字搜尋") End Sub Private Sub 新增_bt_MouseEnter(sender As Object, e As EventArgs) Handles 新增_bt.MouseEnter ToolTip1.SetToolTip(Me.新增_bt, "新增") End Sub Private Sub 確認新增_bt_MouseEnter(sender As Object, e As EventArgs) Handles 儲存_bt.MouseEnter ToolTip1.SetToolTip(Me.儲存_bt, "儲存") End Sub Private Sub 發行_bt_MouseEnter(sender As Object, e As EventArgs) Handles 發行_bt.MouseEnter ToolTip1.SetToolTip(Me.發行_bt, "發行") End Sub Private Sub 修改_bt_MouseEnter(sender As Object, e As EventArgs) Handles 作廢_bt.MouseEnter ToolTip1.SetToolTip(Me.作廢_bt, "作廢") End Sub Private Sub 刪除_bt_MouseEnter(sender As Object, e As EventArgs) Handles 刪除_bt.MouseEnter ToolTip1.SetToolTip(Me.刪除_bt, "刪除") End Sub Private Sub 匯出EXCEL_bt_MouseEnter(sender As Object, e As EventArgs) Handles 列印_bt.MouseEnter ToolTip1.SetToolTip(Me.列印_bt, "匯出PDF") End Sub Private Sub 讀取資料夾路徑_rbt_MouseEnter(sender As Object, e As EventArgs) Handles 讀取資料夾路徑_rbt.MouseEnter ToolTip1.SetToolTip(Me.讀取資料夾路徑_rbt, "選擇電腦的資料夾路徑") End Sub Private Sub 圖檔入系統_rbt_MouseEnter(sender As Object, e As EventArgs) Handles 圖檔入系統_rbt.MouseEnter ToolTip1.SetToolTip(Me.圖檔入系統_rbt, "檔案存入系統") End Sub Private Sub 字體_NUD_ValueChanged(sender As Object, e As EventArgs) Handles 字體_NUD.ValueChanged 主旨_tb.Font = New System.Drawing.Font("微軟正黑體", 字體_NUD.Value) 說明_tb.Font = New System.Drawing.Font("微軟正黑體", 字體_NUD.Value) End Sub Private Sub 列印_bt_Click(sender As Object, e As EventArgs) Handles 列印_bt.Click 'If 登入人級別 <> "00" Then ' 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 新增_bt.Enabled = True 'End If If 檔案名稱_tb.Text = "" Then MsgBox("檔案名稱不可空白!!!") Exit Sub End If Set_清單1() xlApp = CType(CreateObject("Excel.Application"), Microsoft.Office.Interop.Excel.Application) : xlApp.Visible = True : xlApp.DisplayAlerts = True xlApp.Application.WindowState = xlMaximized : xlBook = xlApp.Workbooks.Add : xlSheet = NewMethod(xlBook) : xlBook.Activate() : xlSheet.Activate() xlSheet.Cells(1, 1) = "黃柏翰皮膚科診所" xlSheet.Cells(2, 1) = 主旨_tb.Text Dim largeText As String = 說明_tb.Text ' 使用正则表达式去除多余的换行符 Dim cleanedText As String = Regex.Replace(largeText, "(\r\n|\r|\n)+", vbCrLf) ' 现在根据换行符拆分文本 Dim lines() As String = cleanedText.Split(New String() {vbCrLf}, StringSplitOptions.None) For i As Integer = 0 To lines.Count - 1 字串處理(lines(i)) lines(i) = 已處理字串 Next For i = 0 To Lines.Count - 1 xlSheet.Cells(3 + i, 1) = lines(i) N2 = i + 3 Next BB(xlApp, xlSheet) xlApp.Sheets(2).Delete : xlSheet.PageSetup.PrintArea = "" Dim pdfFolderPath As String = Path.Combine(System.Windows.Forms.Application.StartupPath, "pdf") If Not Directory.Exists(pdfFolderPath) Then Directory.CreateDirectory(pdfFolderPath) End If Dim pdfFilePath As String = Path.Combine(pdfFolderPath, 檔案名稱_tb.Text & ".pdf") xlBook.Sheets(1).ExportAsFixedFormat(XlFixedFormatType.xlTypePDF, pdfFilePath, XlFixedFormatQuality.xlQualityStandard, True) xlApp.Cells.Select() : xlApp.Application.WindowState = xlMinimized : xlBook.Close(False) Runtime.InteropServices.Marshal.ReleaseComObject(xlSheet) Runtime.InteropServices.Marshal.ReleaseComObject(xlBook) Runtime.InteropServices.Marshal.ReleaseComObject(xlApp) xlApp.Quit() : xlSheet = Nothing : xlBook = Nothing : xlApp = Nothing : GC.Collect() Try Dim chromePath As String = "C:\Program Files\Google\Chrome\Application\chrome.exe" If System.IO.File.Exists(chromePath) Then Dim process As New Process() process.StartInfo.FileName = "chrome" process.StartInfo.Arguments = """" & pdfFilePath & """" process.Start() Else : Dim edgePath As String = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe" If System.IO.File.Exists(edgePath) Then Dim process As New Process() process.StartInfo.FileName = "msedge" process.StartInfo.Arguments = """" & pdfFilePath & """" process.Start() Else Process.Start(pdfFilePath) End If End If Catch ex As Exception MsgBox("以存檔至桌面 。" & vbCrLf & "檔案名稱：" & 檔案名稱_tb.Text & ".pdf") End Try End Sub Public Sub 字串處理(ByVal 說明1 As String) Dim 前面空白數量 As Integer = 0 While Strings.Right(說明1, 1) = " " : 說明1 = 說明1.Substring(0, 說明1.Length - 1) : End While While 說明1.StartsWith(" ") : 說明1 = 說明1.Substring(1) : 前面空白數量 += 1 : End While If 說明1.Contains(" ") Then Dim 空白數量() As String = 說明1.Split(" ") : Dim 中間空白數量 As Integer = 1 For j As Integer = 0 To 空白數量.Length - 1 : If 空白數量(j) = "" Then : 中間空白數量 += 1 : End If : Next Dim 要去除的空白數量 As Integer = 中間空白數量 \ 2 : Dim 已去除的數量 As Integer = 0 : Dim 除2字串 As String = "" For i As Integer = 0 To 空白數量.Length - 1 If 空白數量(i) = "" Then : If 已去除的數量 < 要去除的空白數量 Then : 已去除的數量 += 1 : Else : 除2字串 &= " " : End If : Else : 除2字串 &= 空白數量(i) : End If Next : 說明1 = 除2字串 End If If 前面空白數量 > 0 Then : Dim 要增加的空白數量 As Integer = 前面空白數量 \ 2 : For i As Integer = 0 To 要增加的空白數量 - 1 : 說明1 = " " & 說明1 : Next : End If 已處理字串 = 說明1 End Sub Private Shared Function NewMethod(xlBook As Microsoft.Office.Interop.Excel.Workbook) As Microsoft.Office.Interop.Excel.Worksheet Return CType(xlBook.Worksheets.Add, Microsoft.Office.Interop.Excel.Worksheet) End Function Private Sub BB(ByVal myExcel As Microsoft.Office.Interop.Excel.Application, ByVal xlSheet As Microsoft.Office.Interop.Excel.Worksheet) xlSheet.Activate() ' 激活工作表 myExcel.ActiveWindow.View = XlWindowView.xlPageLayoutView myExcel.Application.PrintCommunication = False With myExcel.ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With myExcel.Application.PrintCommunication = True myExcel.ActiveSheet.PageSetup.PrintArea = "" myExcel.Application.PrintCommunication = False With myExcel.ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = myExcel.Application.InchesToPoints(0.7) .RightMargin = myExcel.Application.InchesToPoints(0.7) .TopMargin = myExcel.Application.InchesToPoints(0.3) .BottomMargin = myExcel.Application.InchesToPoints(0.3) .HeaderMargin = myExcel.Application.InchesToPoints(0.3) .FooterMargin = myExcel.Application.InchesToPoints(0.3) .PrintHeadings = False .PrintGridlines = False .CenterHorizontally = True .CenterVertically = False .Draft = False .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = False .FitToPagesWide = 0 .FitToPagesTall = 0 .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With myExcel.Application.PrintCommunication = True xlSheet.Cells.Select() With myExcel.Selection.Font .Name = "微軟正黑體" .Size = 14 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With xlSheet.Columns("A:A").ColumnWidth = 80 xlSheet.Columns("A:A").Select With myExcel.Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With xlSheet.Range("A1").Select() With myExcel.Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With myExcel.Selection.Font .Name = "微軟正黑體" .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontNone .Bold = True End With xlSheet.Range("A2").Select() With myExcel.Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With myExcel.Selection.Font .Name = "微軟正黑體" .Size = 18 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontNone .Bold = True End With xlSheet.Rows("1:1").EntireRow.AutoFit xlSheet.Rows(1).RowHeight = xlSheet.Rows(1).RowHeight + 5 xlSheet.Rows("2:2").EntireRow.AutoFit xlSheet.Rows(2).RowHeight = xlSheet.Rows(1).RowHeight + 5 For i = 3 To N2 xlSheet.Rows(i & ":" & i).Select xlSheet.Rows(i & ":" & i).EntireRow.AutoFit If xlSheet.Rows(i).RowHeight + 5 > 409 Then xlSheet.Rows(i).RowHeight = 409 Else xlSheet.Rows(i).RowHeight = xlSheet.Rows(i).RowHeight + 5 End If Next End Sub End Class