VB实用代码
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
实现按住窗体任何部分都可以拖动窗体
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
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