Option Strict Off Imports Microsoft.Office.Interop.Word Imports Microsoft.Office.Interop Imports System.IO Public Class 開發模板庫 Dim A1, A2, A3, B2, B3 As Integer 'Dim wordApp As New Application 'Dim wordDoc As New Document 'Dim wbBook As Workbook 'Dim wsSheet As Worksheet 'Dim wdbmRange As Range Dim Oword As Application Dim Odoc As Document Dim Otable As Table Private Sub Set_進度明細清單() 工程進度表_dgv.GridColor = Color.White End Sub Private Sub WORD_bt_Click(sender As Object, e As EventArgs) Handles WORD_bt.Click Oword = CreateObject("Word.application") Oword.Visible = True Odoc = Oword.Documents.Add Odoc = Oword.Documents.Open("D:\111.docx") 'Dim wdoc As Document = Word.Documents.Open("c:\\1.doc") 'odoc.PageSetup.Orientation = Word.WdOrientation.wdOrientLandscape '横向显示，试用于横向打印 Odoc.PageSetup.Orientation = Word.WdOrientation.wdOrientPortrait '直向显示，试用于横向打印 Dim opara(1) As Paragraph opara(0) = Odoc.Content.Paragraphs.Add opara(0).Range.Text = "人才资源状况调查统计表" opara(0).Range.Font.Name = "微軟正黑體" : opara(0).Range.Font.Size = 18 : opara(0).Range.Font.Bold = True : opara(0).Range.Font.Color = WdColor.wdColorBlack opara(0).Format.SpaceAfter = 10 : opara(0).Format.SpaceBefore = 2 opara(0).Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter '居中显示 opara(0).Range.InsertParagraphAfter() '在之後插入段落 opara(1) = Odoc.Content.Paragraphs.Add opara(1).Range.Text = "人才资源状况调查统计表123" opara(1).Range.Font.Name = "微軟正黑體" : opara(1).Range.Font.Size = 12 : opara(1).Range.Font.Bold = True : opara(1).Range.Font.Color = WdColor.wdColorBlue opara(1).Format.SpaceAfter = 10 : opara(1).Format.SpaceBefore = 2 opara(1).Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter '居中显示 opara(1).Range.InsertParagraphAfter() '在之後插入段落 Otable = Odoc.Tables.Add(Odoc.Bookmarks.Item("\endofdoc").Range, 7, 3) '表格为7行3列 Otable.Range.ParagraphFormat.SpaceAfter = 6 Otable.Cell(1, 1).Range.Text = "填报单位：" Otable.Cell(2, 1).Range.Text = "负责人：" Otable.Cell(3, 1).Range.Text = "填表人：" Otable.Cell(4, 1).Range.Text = "报出时间：" Otable.Cell(5, 1).Range.Text = "联系电话：" Otable.Cell(1, 2).Range.Text = "TextBox1.Text.ToString" Otable.Cell(1, 2).Range.Underline = Word.WdUnderline.wdUnderlineWords '添加下划线 Otable.Cell(2, 2).Range.Text = "TextBox2.Text.ToString" Otable.Cell(2, 2).Range.Underline = Word.WdUnderline.wdUnderlineWords Otable.Cell(3, 2).Range.Text = "TextBox3.Text.ToString" Otable.Cell(3, 2).Range.Underline = Word.WdUnderline.wdUnderlineWords Otable.Cell(4, 2).Range.Text = Now.Year & "年" & Now.Month & "月" & Now.Day & "日" Otable.Cell(4, 2).Range.Underline = Word.WdUnderline.wdUnderlineWords Otable.Cell(5, 2).Range.Text = "TextBox4.Text.ToString" Otable.Cell(5, 2).Range.Underline = Word.WdUnderline.wdUnderlineWords Otable.Cell(6, 2).Range.Text = "部门组织部" Otable.Cell(7, 2).Width = 250 Otable.Cell(7, 2).Range.Text = "人力资源管理企业" Otable.Cell(1, 3).Range.Text = "(盖章)" Otable.Cell(2, 3).Range.Text = "(签字)" Otable.Cell(3, 3).Range.Text = "(签字)" Otable.Cell(6, 3).Range.Text = "(制)" Otable.Cell(7, 3).Range.Text = Now.Year & "年" & Now.Month & "月" Oword.ActiveDocument.SaveAs("C:\Users\USER\Desktop\1234.docx") End Sub Private Sub 開發模板庫_Load(sender As Object, e As EventArgs) Handles MyBase.Load A1 = 空間1.Location.X : A2 = 空間2.Location.X : B2 = 空間2.Location.Y : A3 = 空間2.Size.Width : B3 = 空間2.Size.Height With GanttChart1 .FromDate = New Date(2007, 11, 1) .ToDate = New Date(2007, 12, 31) Dim lst As New List(Of BarInformation) From { New BarInformation("Row 1", New Date(2007, 12, 12), New Date(2007, 12, 16), Color.Aqua, Color.Khaki, 0), New BarInformation("Row 2", New Date(2007, 12, 13), New Date(2007, 12, 20), Color.AliceBlue, Color.Khaki, 1), New BarInformation("Row 3", New Date(2007, 12, 14), New Date(2007, 12, 24), Color.Violet, Color.Khaki, 2), New BarInformation("Row 4", New Date(2007, 12, 21), New Date(2007, 12, 22), Color.Yellow, Color.Khaki, 3), New BarInformation("Row 5", New Date(2007, 12, 17), New Date(2007, 12, 24), Color.LawnGreen, Color.Khaki, 4) } For Each bar As BarInformation In lst .AddChartBar(bar.RowText, bar, bar.FromTime, bar.ToTime, bar.Color, bar.HoverColor, bar.Index) Next End With '----亂數生成器---------------------------- Randomize() End Sub Private Sub 開發模板庫_SizeChanged(sender As Object, e As EventArgs) Handles MyBase.SizeChanged A1 = 空間1.Location.X : A2 = 錨點1.Location.X : B2 = 空間2.Location.Y If 空間1.Visible = False Then : A3 = 空間2.Size.Width : B3 = 空間2.Size.Height : A3 -= (A2 - A1) : End If End Sub Private Sub 工程進度表_dgv_RowPostPaint(ByVal sender As Object, ByVal e As DataGridViewRowPostPaintEventArgs) Handles 工程進度表_dgv.RowPostPaint Dim linePen As New Pen(Color.DarkGray, 1) If e.RowIndex = 工程進度表_dgv.Rows.Count Then Exit Sub Else Dim YYY, XXX As Integer If e.RowIndex <= 工程進度表_dgv.Rows.Count Then Dim startX As Integer = IIf(工程進度表_dgv.RowHeadersVisible, 工程進度表_dgv.RowHeadersWidth, 0) Dim startY As Integer = e.RowBounds.Top + e.RowBounds.Height - 1 Dim endX As Integer = startX + 工程進度表_dgv.Columns.GetColumnsWidth(DataGridViewElementStates.Visible) - 工程進度表_dgv.HorizontalScrollingOffset Dim startX2 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(2).Width, 0) Dim startX3 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(3).Width, 0) Dim startX4 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(4).Width, 0) Dim startX5 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(5).Width, 0) Dim startX6 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(6).Width, 0) Dim startX7 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(7).Width, 0) Dim startX8 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(12).Width, 0) Dim startX9 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(13).Width, 0) Dim startX10 As Integer = IIf(工程進度表_dgv.ColumnHeadersVisible, 工程進度表_dgv.Columns(14).Width, 0) e.Graphics.DrawLine(linePen, startX, startY, endX, startY) YYY += startY If 工程進度表_dgv.Columns(2).Visible = True Then XXX = startX + startX2 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 + startX5 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 + startX5 + startX6 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 + startX5 + startX6 + startX7 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 + startX5 + startX6 + startX7 + startX8 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 + startX5 + startX6 + startX7 + startX8 + startX9 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX2 + startX3 + startX4 + startX5 + startX6 + startX7 + startX8 + startX9 + startX10 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) Else XXX = startX + startX3 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX3 + startX4 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX3 + startX4 + startX5 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX3 + startX4 + startX5 + startX6 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) XXX = startX + startX3 + startX4 + startX5 + startX6 + startX7 : e.Graphics.DrawLine(linePen, XXX, 0, XXX, YYY) End If : Exit Sub End If End If End Sub Private Sub ZOOM_bt_Click(sender As Object, e As EventArgs) Handles ZOOM_bt.Click If 空間1.Visible = True Then A3 = 空間2.Size.Width : B3 = 空間2.Size.Height 空間1.Visible = False : 空間2.Location = New Drawing.Point(A1, B2) : 空間2.Size = New Drawing.Point(A2 - A1 + A3, B3) Else 空間1.Visible = True : 空間2.Location = New Drawing.Point(A2, B2) : 空間2.Size = New Drawing.Point(A3, B3) End If End Sub Private Sub 甘特圖計算_bt_Click(sender As Object, e As EventArgs) Handles 甘特圖計算_bt.Click With GanttChart1 .FromDate = New Date(2007, 11, 1) .ToDate = New Date(2007, 12, 31) Dim lst As New List(Of BarInformation) From { New BarInformation("Row 1", New Date(2007, 12, 12), New Date(2007, 12, 16), Color.Aqua, Color.Khaki, 0), New BarInformation("Row 2", New Date(2007, 12, 13), New Date(2007, 12, 20), Color.AliceBlue, Color.Khaki, 1), New BarInformation("Row 3", New Date(2007, 12, 14), New Date(2007, 12, 24), Color.Violet, Color.Khaki, 2), New BarInformation("Row 4", New Date(2007, 12, 21), New Date(2007, 12, 22), Color.Yellow, Color.Khaki, 3), New BarInformation("Row 5", New Date(2007, 12, 17), New Date(2007, 12, 24), Color.LawnGreen, Color.Khaki, 4), New BarInformation("Row 6", New Date(2007, 12, 12), New Date(2007, 12, 16), Color.Aqua, Color.Khaki, 5), New BarInformation("Row 7", New Date(2007, 12, 13), New Date(2007, 12, 20), Color.AliceBlue, Color.Khaki, 6), New BarInformation("Row 8", New Date(2007, 12, 14), New Date(2007, 12, 24), Color.Violet, Color.Khaki, 7), New BarInformation("Row 9", New Date(2007, 12, 21), New Date(2007, 12, 22), Color.Yellow, Color.Khaki, 8), New BarInformation("Row 10", New Date(2007, 12, 17), New Date(2007, 12, 24), Color.LawnGreen, Color.Khaki, 9) } For Each bar As BarInformation In lst .AddChartBar(bar.RowText, bar, bar.FromTime, bar.ToTime, bar.Color, bar.HoverColor, bar.Index) Next End With End Sub Private Sub 甘特圖清除_bt_Click(sender As Object, e As EventArgs) Handles 甘特圖清除_bt.Click With GanttChart1 .FromDate = New Date(2007, 11, 1) .ToDate = New Date(2007, 12, 31) Dim lst As New List(Of BarInformation) lst.Clear() .RemoveBars() End With End Sub Private Sub 甘特圖存檔_bt_Click(sender As Object, e As EventArgs) Handles 甘特圖存檔_bt.Click SaveImage(GanttChart1) End Sub Private Sub SaveImage(ByVal gantt As GanttChart) '----圖像存檔--------- Dim filePath As String = InputBox("Where to save the file?", "Save image", "D:\GanttChartTester.jpg") If filePath.Length = 0 Then Exit Sub gantt.SaveImage(filePath) MsgBox("Picture saved", MsgBoxStyle.Information) End Sub '----------------------自創視窗滑鼠拖曳功能--------------------------------------------------------------------------------------------------------- Dim OldX, OldY As Long : Dim drag As Boolean Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged WebBrowser1.Url = New Uri(TextBox1.Text) End Sub Private Sub 修改群組_bt_Click(sender As Object, e As EventArgs) Handles 修改群組_bt.Click If 視窗1_pl.Visible = False Then : 視窗1_pl.Visible = True : 視窗1_pl.BringToFront() : Else : 視窗1_pl.Visible = False : End If End Sub Private Sub Cancel_bt_Click(sender As Object, e As EventArgs) Handles Cancel_bt.Click If 視窗1_pl.Visible = False Then : 視窗1_pl.Visible = True : 視窗1_pl.BringToFront() : Else : 視窗1_pl.Visible = False : End If End Sub Private Sub 物料群組1_Panel_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 視窗1_pl.MouseDown If e.Button = MouseButtons.Left Then : OldX = e.X : OldY = e.Y : drag = True : End If End Sub Private Sub 物料群組1_Panel_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 視窗1_pl.MouseMove If drag Then : 視窗1_pl.Left = 視窗1_pl.Left + e.X - OldX : 視窗1_pl.Top = 視窗1_pl.Top + e.Y - OldY : End If End Sub Private Sub 物料群組1_Panel_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 視窗1_pl.MouseUp drag = False End Sub '----------------------GOOGLE翻譯功能--------------------------------------------------------------------------------------------------------- Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If 輸入_tb.Text = "" Then : MsgBox("沒有資料") : Else 翻譯 = Replace(輸入_tb.Text, vbCrLf, " ") MyModule2.執行翻譯() 等待翻譯_tim.Enabled = True End If End Sub Private Sub 等待翻譯_tim_Tick(sender As Object, e As EventArgs) Handles 等待翻譯_tim.Tick Dim Str2 As String = System.Windows.Forms.Application.StartupPath : Dim stringReader As String : Dim fileReader As StreamReader If File.Exists("ch.txt") Then 等待翻譯_tim.Enabled = False fileReader = My.Computer.FileSystem.OpenTextFileReader(Str2 & "\ch.txt") : stringReader = fileReader.ReadLine() : 中文_tb.Text = stringReader : fileReader.Close() fileReader = My.Computer.FileSystem.OpenTextFileReader(Str2 & "\en.txt") : stringReader = fileReader.ReadLine() : 英文_tb.Text = stringReader : fileReader.Close() fileReader = My.Computer.FileSystem.OpenTextFileReader(Str2 & "\in.txt") : stringReader = fileReader.ReadLine() : 印尼文_tb.Text = stringReader : fileReader.Close() MsgBox("翻譯完成!") ElseIf File.Exists(Str2 & "\ch.txt") Then 等待翻譯_tim.Enabled = False fileReader = My.Computer.FileSystem.OpenTextFileReader(Str2 & "\ch.txt") : stringReader = fileReader.ReadLine() : 中文_tb.Text = stringReader : fileReader.Close() fileReader = My.Computer.FileSystem.OpenTextFileReader(Str2 & "\ch.txt") : stringReader = fileReader.ReadLine() : 英文_tb.Text = stringReader : fileReader.Close() fileReader = My.Computer.FileSystem.OpenTextFileReader(Str2 & "\ch.txt") : stringReader = fileReader.ReadLine() : 印尼文_tb.Text = stringReader : fileReader.Close() MsgBox("翻譯完成!") End If End Sub End Class