Imports Microsoft.Office.Core
Imports Microsoft.Office.Interop.Word
Partial Public Class ReportRibbon

#Region "功能区回调"
    '在此处创建回叫方法。有关添加回叫方法的详细信息，请访问 https://go.microsoft.com/fwlink/?LinkID=271226
    Public Sub Ribbon_Load(ByVal ribbonUI As Office.IRibbonUI)
        Me.ribbon = ribbonUI
    End Sub

    Private Const targetWidth = 175.748
    Private Const targetHeight = 113.3858
    Public Sub ActiveDocumentIntertImages(ByRef control As IRibbonControl)
        Dim Selection As Selection = control.Context.Selection
        Dim Application As Application = control.Context.Application
        If Selection.Information(WdInformation.wdWithInTable) Then
            Dim i&
            Dim aCell As Cell, walkCell As Cell
            Dim AllRow As Rows

            AllRow = Selection.Tables(1).Rows

            aCell = Selection.Cells(1)
            walkCell = aCell
            Dim files As FileDialog
            files = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
            With files
                .Title = "选择要插入图片"
                .AllowMultiSelect = True
                .Filters.Clear()
                .Filters.Add("图片", "*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.tif;*.tif;*.svg;*.ico;*.webp")
            End With

            If files.Show = -1 Then

                Dim ct As Long, obj As FileDialogSelectedItems
                obj = files.SelectedItems
                ct = obj.Count
                i = 1
                For Each Item In obj
                    If aCell Is Nothing Then
                        AllRow.Add()
                        aCell = walkCell?.Next
                    Else
                        aCell.Range.Delete()
                    End If

                    With aCell.Range.InlineShapes.AddPicture(Item)
                        If .Width > .Height Then
                            .Width = targetWidth
                            .Height = targetHeight
                        Else
                            .Width = targetHeight
                            .Height = targetWidth
                        End If
                    End With

                    With aCell.Range
                        .Font.Name = "黑体"
                        .Font.Size = 10
                        If i = 1 Then
                            .InsertAfter(vbCrLf & "试验前")
                            .Font.Name = "Arial"
                            .InsertAfter("Before the test")
                        ElseIf i = ct Then
                            .InsertAfter(vbCrLf & "试验后")
                            .Font.Name = "Arial"
                            .InsertAfter("After the test")
                        Else
                            .InsertAfter(vbCrLf & "试验中")
                            .Font.Name = "Arial"
                            .InsertAfter("In process")
                        End If
                        .ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
                    End With
                    aCell.VerticalAlignment = WdCellVerticalAlignment.wdCellAlignVerticalTop
                    i += 1
                    'acell.Range.PasteSpecial Link:=False, DataType:=wdPasteFormat

                    walkCell = aCell
                    aCell = aCell.Next
                    'Exit For
                Next
                If aCell IsNot Nothing Then

                    Dim rs&, re&
                    re = Selection.Tables(1).Range.End

                    Do Until aCell Is Nothing
                        If aCell.RowIndex <> walkCell.RowIndex Then
                            Exit Do
                        End If
                        aCell = aCell.Next
                    Loop

                    If aCell IsNot Nothing Then
                        rs = aCell.Range.Start
                        With Selection
                            .SetRange(rs, re)
                            .Rows.Delete()
                        End With
                    End If

                    aCell = walkCell.Next

                    Do Until aCell Is Nothing
                        aCell.VerticalAlignment = WdCellVerticalAlignment.wdCellAlignVerticalCenter
                        With aCell.Range
                            .Delete()
                            .ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
                            .InsertAfter("/")
                        End With
                        aCell = aCell.Next
                    Loop

                End If
                Selection.Document.Save()
                MsgBox("完成", Application.Name)
            Else
                MsgBox("你已取消操作", Application.Name)
            End If

        Else
            MsgBox("光标不在表格中", Application.Name)
        End If
    End Sub

    Public Sub ActiveDocumentFormatCurTableImages(ByRef control As IRibbonControl)
        Dim cell As Cell
        Dim shp As InlineShape
        Dim tbl As Table
        Dim Selection As Selection = control.Context.Selection

        ' 检查光标是否在表格中
        If Selection.Information(WdInformation.wdWithInTable) Then
            ' 获取当前表格对象
            tbl = Selection.Tables(1)
            For Each cell In tbl.Range.Cells
                ' 遍历单元格中的每个形状（图片）
                For Each shp In cell.Range.InlineShapes
                    ' 调整图片大小
                    'Debug.Print shp.Width; shp.Height
                    shp.LockAspectRatio = MsoTriState.msoFalse
                    If shp.Width > shp.Height Then
                        shp.Width = targetWidth
                        shp.Height = targetHeight
                    Else
                        shp.Width = targetHeight
                        shp.Height = targetWidth
                    End If

                Next shp
            Next cell
            Selection.Document.Save()
            MsgBox("ok", Selection.Application.Name)
        Else
            MsgBox("光标不在表格中。", Selection.Application.Name)
        End If
    End Sub

    Public Sub ActiveDocumentInsertZhang(ByRef control As IRibbonControl)
        Dim fd As FileDialog
        Dim Application As Word.Application = control.Context.Application
        fd = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
        With fd
            .Title = "请选择骑缝章"
            .Filters.Clear()
            .Filters.Add("图片", "*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.tif;*.tif;*.svg;*.ico;*.webp")
        End With
        If fd.Show() = -1 Then
            Dim pageNum&
            Dim status As Boolean
            pageNum = Application.ActiveDocument.ComputeStatistics(WdStatistic.wdStatisticPages)
            If pageNum < 2 Then
                ActiveDocumentInsertZhangOne(fd.SelectedItems.Item(1), 1, 0, status, Application.Selection)
                GoTo OK
            End If

            Application.Selection.GoTo(WdGoToItem.wdGoToPage, WdGoToDirection.wdGoToFirst)
            Dim zh As Zhang = GetMethod(pageNum, 10)

            'For Each Item In zh.listHead
            '   Debug.Print Item
            'Next
            'Debug.Print zh.StepLength; zh.Count

            For Each Item In zh.listHead
                For i = 0 To Item - 1
                    ActiveDocumentInsertZhangOne(fd.SelectedItems.Item(1), CLng(Item), CLng(i), status, Application.Selection)
                Next
            Next

            For i = 1 To zh.Count
                For j = 0 To zh.StepLength - 1
                    ActiveDocumentInsertZhangOne(fd.SelectedItems.Item(1), zh.StepLength, CLng(j), status, Application.Selection)
                Next
            Next
OK:
            Application.Selection.GoTo(WdGoToItem.wdGoToPage, WdGoToDirection.wdGoToLast)
            Application.ActiveDocument.Save()
            MsgBox(Prompt:="完成", Title:=Application.Name)
        End If


    End Sub
#End Region
    Private Function GetMethod(pagesNum&, splitNum&) As Zhang
        If pagesNum < 2 Or splitNum < 2 Then
            GetMethod = Nothing
            Exit Function
        End If

        GetMethod = New Zhang With {
            .StepLength = splitNum
        }
        Dim yu&, shang&, ln&
        ln = splitNum - 1
        shang = pagesNum \ ln
        yu = pagesNum Mod ln

        If pagesNum <= splitNum Then
            GetMethod.listHead.Add(pagesNum)
            GetMethod.Count = 0
        Else
            If yu > 0 Then
                Dim x&, y&
                x = (yu + ln) \ 2
                y = yu + ln - x
                GetMethod.listHead.Add(y)
                GetMethod.listHead.Add(x + 1)
            Else
                GetMethod.listHead.Add(yu + splitNum)
            End If
            GetMethod.Count = shang - 1
        End If
    End Function
    Private Sub ActiveDocumentInsertZhangOne(ImPath$, splitNum&, offset&, ByRef status As Boolean, ByRef selection As Selection)
        With selection.Range.InlineShapes.AddPicture(ImPath).ConvertToShape
            On Error Resume Next
            .Top = .Top + .Height
            .LockAspectRatio = MsoTriState.msoTrue
            .Height = 107.7165 '3.8cm
            .WrapFormat.Type = WdWrapType.wdWrapBehind
            Dim pice As Single = .Width / splitNum
            With .PictureFormat.Crop
                .PictureOffsetX = -pice * offset
                .ShapeWidth = pice
            End With

            .Select()
            With selection.Application.CommandBars
                .ExecuteMso("ObjectsAlignRelativeToContainerSmart")
                .ExecuteMso("ObjectsAlignRightSmart")
                .ExecuteMso("ObjectsAlignBottomSmart")
            End With

            .Top = .Top - .Height * (2 + status)
        End With
        If offset <> splitNum - 1 Then
            selection.GoTo(WdGoToItem.wdGoToPage, WdGoToDirection.wdGoToNext)
        Else
            status = Not status
        End If
    End Sub
End Class