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 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 N2 As Integer : Dim N3 As Integer ReadOnly ds As New DataSet : ReadOnly ds1 As New DataSet Private Sub 疏文_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.MdiParent = ICS_ASMS_ERP_SYS : Me.WindowState = 2 : Me.AutoScroll = True SQL_讀取公司資料() If dr.Read() Then 公司名稱.Text = dr("公司名稱") End If conn.Close() 已核准的營運成本收支單_rb.Checked = True 作廢的營運成本收支單_rb.Checked = False Set_清單1() 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = False : 列印_bt.Enabled = False 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 Then SQL_通用_控制表清單1("疏文") ElseIf 作廢的營運成本收支單_rb.Checked = False And 已核准的營運成本收支單_rb.Checked = True Then SQL_通用_控制表清單("疏文") End If da.Fill(ds1) : 控制表_dgv.DataSource = ds1.Tables(0) : conn.Close() 控制表_dgv.Columns(0).FillWeight = 30 : 控制表_dgv.Columns(1).FillWeight = 70 : 控制表_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 : 控制表_dgv.Columns(11).Visible = False 控制表_dgv.Columns(12).Visible = False : 控制表_dgv.Columns(13).Visible = False : 控制表_dgv.Columns(14).Visible = False 控制表_dgv.Columns("開單人").Visible = False 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(5, e.RowIndex).Value.ToString ComboBox1.Text = 控制表_dgv(6, e.RowIndex).Value.ToString ComboBox2.Text = 控制表_dgv(7, e.RowIndex).Value.ToString ComboBox3.Text = 控制表_dgv(8, e.RowIndex).Value.ToString ComboBox4.Text = 控制表_dgv(9, e.RowIndex).Value.ToString ComboBox5.Text = 控制表_dgv(10, e.RowIndex).Value.ToString ComboBox6.Text = 控制表_dgv(11, e.RowIndex).Value.ToString ComboBox7.Text = 控制表_dgv(12, e.RowIndex).Value.ToString ComboBox7.Text = 控制表_dgv(12, e.RowIndex).Value.ToString 開單人_tb.Text = 控制表_dgv("開單人", e.RowIndex).Value.ToString If 登入人級別 <> "00" Then If 控制表_dgv(14, e.RowIndex).Value = True Then 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = False : 列印_bt.Enabled = True : 新增_bt.Enabled = True ElseIf 控制表_dgv(13, e.RowIndex).Value = True And 控制表_dgv(14, e.RowIndex).Value = False Then 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 新增_bt.Enabled = True ElseIf 控制表_dgv(13, e.RowIndex).Value = False And 控制表_dgv(14, e.RowIndex).Value = False Then 刪除_bt.Enabled = True : 儲存_bt.Enabled = True : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 新增_bt.Enabled = True End If Else 刪除_bt.Enabled = True : 儲存_bt.Enabled = True : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 新增_bt.Enabled = True End If 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 = "" ComboBox1.Text = "" : ComboBox2.Text = "" : ComboBox3.Text = "" : ComboBox4.Text = "" ComboBox5.Text = "" : ComboBox6.Text = "" : ComboBox7.Text = "" Dim NUM1 As Integer Dim dat1 As String 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 : 開單人_tb.Text = gUserName SQL_通用_新增一筆公函控制表("疏文") : conn.Close() 刪除_bt.Enabled = True : 儲存_bt.Enabled = True : 作廢_bt.Enabled = False : 列印_bt.Enabled = False : 新增_bt.Enabled = False End Sub Private Sub 刪除_bt_Click(sender As Object, e As EventArgs) Handles 刪除_bt.Click SQL_通用_控制表刪除(單號_tb.Text) : conn.Close() : MsgBox("刪除成功!!") 單號_tb.Text = "" : 檔案名稱_tb.Text = "" : 主旨_tb.Text = "" : 說明_tb.Text = "" : 擬辦_tb.Text = "" ComboBox1.Text = "" : ComboBox2.Text = "" : ComboBox3.Text = "" : ComboBox4.Text = "" ComboBox5.Text = "" : ComboBox6.Text = "" : ComboBox7.Text = "" : Set_清單1() 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = False : 列印_bt.Enabled = False : 新增_bt.Enabled = True End Sub Private Sub 儲存_bt_Click(sender As Object, e As EventArgs) Handles 儲存_bt.Click If 開單人_tb.Text = gUserName Or 登入人級別 = "00" Then SQL_通用_控制表修改(檔案名稱_tb.Text, 主旨_tb.Text, 說明_tb.Text, 擬辦_tb.Text, ComboBox1.Text, ComboBox2.Text, ComboBox3.Text, ComboBox4.Text, ComboBox5.Text, ComboBox6.Text, ComboBox7.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() 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = False : 列印_bt.Enabled = True End Sub Private Sub 作廢的營運成本收支單_rb_CheckedChanged(sender As Object, e As EventArgs) Handles 作廢的營運成本收支單_rb.Click 作廢的營運成本收支單_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 = True Set_清單1() 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 匯出EXCEL_bt_MouseEnter(sender As Object, e As EventArgs) Handles 列印_bt.MouseEnter ToolTip1.SetToolTip(Me.列印_bt, "匯出PDF") 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) 擬辦_tb.Font = New System.Drawing.Font("微軟正黑體", 字體_NUD.Value) End Sub Private Sub 列印_bt_Click(sender As Object, e As EventArgs) Handles 列印_bt.Click SQL_通用_控制表鎖定(單號_tb.Text, "疏文") If 登入人級別 <> "00" Then 刪除_bt.Enabled = False : 儲存_bt.Enabled = False : 作廢_bt.Enabled = True : 列印_bt.Enabled = True : 新增_bt.Enabled = True 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() Dim 說明本文 As String Dim 疏文行數 As Integer = 0 Dim 疏文頁數 As Integer 說明本文 = 說明_tb.Text While 說明本文.Contains(vbCrLf) Dim vbCrLfIndex As Integer = 說明本文.IndexOf(vbCrLf) 疏文單行內容(疏文行數) = 說明本文.Substring(0, vbCrLfIndex) 說明本文 = 說明本文.Substring(vbCrLfIndex + 2) : 疏文行數 += 1 End While If 說明本文 <> "" Then 疏文單行內容(疏文行數) = 說明本文 : 疏文行數 += 1 End If 疏文頁數 = Math.Ceiling(疏文行數 / 44) xlSheet.Cells(1, 37) = 主旨_tb.Text xlSheet.Cells(1 + (疏文頁數 - 1) * 30, 2) = 擬辦_tb.Text For i As Integer = 1 To 疏文頁數 BB(xlApp, xlSheet, i) Next AA(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 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 AA(ByVal myExcel As Microsoft.Office.Interop.Excel.Application, ByVal xlSheet As Microsoft.Office.Interop.Excel.Worksheet) '====列印====== myExcel.Application.PrintCommunication = False With myExcel.ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With myExcel.Application.PrintCommunication = True myExcel.ActiveSheet.PageSetup.PrintArea = "" myExcel.ActiveSheet.PageSetup.CenterHeaderPicture.Filename = System.Windows.Forms.Application.StartupPath & "\pic\ASSS.png" With myExcel.ActiveSheet.PageSetup.CenterHeaderPicture .Height = 1398 .Width = 2189.25 End With myExcel.Application.PrintCommunication = False With myExcel.ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "&G" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = myExcel.Application.InchesToPoints(0.25) .RightMargin = myExcel.Application.InchesToPoints(0.25) .TopMargin = myExcel.Application.InchesToPoints(0.75) .BottomMargin = myExcel.Application.InchesToPoints(0.75) .HeaderMargin = myExcel.Application.InchesToPoints(0.3) .FooterMargin = myExcel.Application.InchesToPoints(0.3) .PrintHeadings = False .PrintGridlines = False .CenterHorizontally = False .CenterVertically = False .Draft = False .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = 100 .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 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.25) .RightMargin = myExcel.Application.InchesToPoints(0.25) .TopMargin = myExcel.Application.InchesToPoints(0.75) .BottomMargin = myExcel.Application.InchesToPoints(0.75) .HeaderMargin = myExcel.Application.InchesToPoints(0.3) .FooterMargin = myExcel.Application.InchesToPoints(0.3) .PrintHeadings = False .PrintGridlines = False '.PrintQuality = 600 .CenterHorizontally = True .CenterVertically = True .Orientation = XlPageOrientation.xlLandscape .Draft = False .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .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 myExcel.ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$30" End Sub Private Sub BB(ByVal myExcel As Microsoft.Office.Interop.Excel.Application, ByVal xlSheet As Microsoft.Office.Interop.Excel.Worksheet, ByVal 疏文頁數 As Integer) Dim col As New List(Of String) From {"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL"} If 疏文頁數 = 1 Then For i As Integer = 1 To 34 : myExcel.Columns(col(i) & ":" & col(i)).ColumnWidth = 8.5 : Next myExcel.Columns("A:A").ColumnWidth = 13 myExcel.Columns("AK:AK").ColumnWidth = 14.63 myExcel.Columns("AJ:AJ").ColumnWidth = 14.63 myExcel.Columns("AL:AL").ColumnWidth = 13 End If Dim for1 As Integer = (疏文頁數 - 1) * 30 + 1 Dim for2 As Integer = 疏文頁數 * 30 For i As Integer = for1 To for2 : myExcel.Rows(i & ":" & i).RowHeight = 36.75 : Next myExcel.Range("B" & for1 & ":B" & for2).Select() With myExcel.Selection .HorizontalAlignment = xlCenter : .VerticalAlignment = xlTop : .WrapText = False : .Orientation = 0 : .AddIndent = False : .IndentLevel = 0 : .ShrinkToFit = False .ReadingOrder = xlContext : .MergeCells = False End With myExcel.Selection.Merge With myExcel.Selection .HorizontalAlignment = xlCenter : .VerticalAlignment = xlCenter : .WrapText = False : .Orientation = XlOrientation.xlVertical : .AddIndent = False : .IndentLevel = 0 .ShrinkToFit = False : .ReadingOrder = xlContext : .MergeCells = True End With With myExcel.Selection.Font .Name = "標楷體" : .Size = 26 : .Strikethrough = False : .Superscript = False : .Subscript = False : .OutlineFont = False : .Shadow = False : .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 : .TintAndShade = 0 : .ThemeFont = xlThemeFontNone End With myExcel.Range("AK" & for1 & ":AK" & for2).Select() With myExcel.Selection .HorizontalAlignment = xlCenter : .VerticalAlignment = xlCenter : .WrapText = False : .Orientation = XlOrientation.xlVertical : .AddIndent = False : .IndentLevel = 0 .ShrinkToFit = False : .ReadingOrder = xlContext : .MergeCells = True End With With myExcel.Selection.Font .Name = "標楷體" : .Size = 50 : .Strikethrough = False : .Superscript = False : .Subscript = False : .OutlineFont = False : .Shadow = False : .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 : .TintAndShade = 0 : .ThemeFont = xlThemeFontNone : .Bold = True End With myExcel.ActiveSheet.Shapes.AddTextbox(1, 165, 31.8749606299, 1741.8749606299, 1065).Select myExcel.ActiveSheet.Shapes.Range("TextBox 1").Select() With myExcel.Selection.ShapeRange.TextFrame2.TextRange.Font .NameComplexScript = "標楷體" .NameFarEast = "標楷體" .Name = "標楷體" End With Dim 說文內文 As String = "" For i As Integer = (疏文頁數 - 1) * 44 To (疏文頁數 - 1) * 44 + 43 If i = (疏文頁數 - 1) * 44 Then : 說文內文 = 疏文單行內容(i) : Else : 說文內文 += vbCrLf & 疏文單行內容(i) : End If Next myExcel.Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 28 myExcel.Selection.ShapeRange.TextFrame2.Orientation = 6 '4 myExcel.Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = 7 myExcel.Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = 說文內文 myExcel.Selection.ShapeRange.Line.Visible = 0 End Sub End Class