实现按住窗体任何部分都可以拖动窗体
Dim mX As Long, mY As Long
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button And vbLeftButton Then mX = X: mY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button And vbLeftButton Then Me.Move Me.Left - mX + X, Me.Top - mY + Y
End Sub
============================================================================
调用Excel的代码
Dim ObjExcelApp, ObjExcelBook, ObjExcelSheet As Object
    Set ObjExcelApp = CreateObject("excel.application")  '调用Excel程序
    Set ObjExcelBook = ObjExcelApp.Workbooks.Add  '设置要使用的工作簿
Set ObjExcelSheet = ObjExcelBook.Sheets(1)  '设置活动工作表
    With ObjExcelSheet
        .cells(2, 1) = "委托编号"        ‘向单元格中写数据
        .cells(1, 1).Font.Size = 14        ‘设置字号
        .cells(1, 1).Font.Bold = True      ‘加粗
        .Rows("4:4").RowHeight = 30    ‘设置行高
        .range("A1:I1").mergecells = True  ‘合并单元格
        .range(.cells(StartRow, 1), .cells(EndRow, 1)).merge    ‘合并单元格
        .Columns(i).autofit            ‘列自动适应内容
        .range(.cells(1, 1), .cells(List1.ListCount + 5, 9)).HorizontalAlignment = 3  '居中显示
        '主关键字为A列，次关键字依次为B、C列进行升序排序
        .range(.cells(6, 1), .cells(List1.ListCount + 5, 8)).Sort Key1:=.range("A5") _
            , Order1:=1, key2:=.range("B5"), order2:=1, key3:=.range("C5"), order3:=1
    End With
ObjExcelApp.Quit                ‘结束Excel进程
将picturebox中的图片保存为JPG格式
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
Private Type EncoderParameter
getsavefilename    GUID As GUID
    NumberOfValues As Long
    type As Long
    Value As Long
End Type
Private Type EncoderParameters
    Count As Long
    Parameter As EncoderParameter
End Type
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
' ----==== SaveJPG ====----
Public Sub SaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80)  '压缩质量=80
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
    ' Initialize GDI+
    tSI.GdiplusVersion = 1
    lRes = GdiplusStartup(lGDIP, tSI)
    If lRes = 0 Then
   
    ' Create the GDI+ bitmap
    ' from the image handle
    lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
   
        If lRes = 0 Then
        Dim tJpgEncoder As GUID
        Dim tParams As EncoderParameters
           
            ' Initialize the encoder GUID
            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
           
            ' Initialize the encoder parameters
            tParams.Count = 1
            With tParams.Parameter ' Quality
                ' Set the Quality GUID
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
                .NumberOfValues = 1
                .type = 4
                .Value = VarPtr(quality)
            End With
           
            ' Save the image
            lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)
           
            ' Destroy the bitmap
            GdipDisposeImage lBitmap
       
        End If
       
        ' Shutdown GDI+
        GdiplusShutdown lGDIP
    End If
    If lRes Then
        Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
    End If
End Sub
'用法 Call SaveJPG(Picture1.Image, "文件名(含路径)",100)  '100为压缩质量=100%
Type DlgFileInfo
    iCount As Long

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。