Question

求高手教我做几道VB编程题

我们明天要考计算机二级考试，还有几道编程题不懂做，希望有一个高手能在线教我，我的QQ305023455，拜托了！

Answer 1

你要做什么题目

Answer 2

Private Sub ComB_savetoMHT_Click()
Dim savetoFilename As String
On Error GoTo toDonothing
With CommonDialog
.ShowSave
savetoFilename = .Filename & ".mht"
.Filename = savetoFilename
Open .Filename For Output As #1
Close #1
End With
toDonothing:
End Sub
_________________________
如何用程序取消excel的行隐藏？
Rows("5:10").Select
Selection.EntireRow.Hidden=False
_________________________
excel 怎样保护部分单元格
隐藏是不让别人看到你的单元格内容，真正要做到保护，就用以下的方式，可以让你随心所欲的结任一单元格进行保护：
1、全选你工作表中的内容，选菜单栏中的格式项下的“单元格”项。
2、去掉勾选“保护”项内的”锁定，之后“确定退出。
3、选定你要进行保护的单元格，重复1、选菜单栏中的格式项下的“单元格”项。
4、在“保护”项内，勾选“锁定”之后退出。
5、在菜单“工具”下选“保护”内之“保护工作表”。
6、在打开的窗口内只选定以下二项：“保护工作表及锁定的单元格内容”和下面的”选定未锁定的单元格“后输入密码，确定即可。
7、你会发现，除了这些锁死不能动外，其他的你一样还可以编辑。
注意退出前要保存文档。
___________________________
Excel操作中隐藏单元格内容的技巧
1.隐藏单元格内容
选择要隐藏的单元格区域，在“格式”菜单中单击“单元格”，单击“数字”选项卡，在“分类”框中，单击“自定义”，然后在“类型”框中键入三个半角的分号“;;;”。单击“确定”按钮。
此时，这些单元格中的内容将不会显示在工作表中的单元格中，但当你单击某个单元格后，编辑栏中将会显示其内容。如果希望在编辑栏中也不显示其内容，请继续下面的操作。
2.隐藏编辑栏内容
再次选择要隐藏的单元格区域，在“格式”菜单中单击“单元格”，单击“保护”选项卡，选中“隐藏”复选框，单击“确定”按钮。接着在“工具”菜单中选择“保护”子菜单，单击“保护工作表”，然后选中“保护工作表及锁定的单元格内容”复选框，还可以在“取消工作表保护时使用的密码”框中键入密码。单击“确定”按钮。
以后，如果需要在编辑栏中显示这些单元格的内容，请在“工具”菜单中选择“保护”子菜单，单击“撤消工作表保护”；要在单元格中显示其内容，请删除设置单元格格式时在“类型”框中自定义的“;;;”符号即可。
___________________________________
Sub a11111111111111()
Selection.Locked = True
Selection.FormulaHidden = False
Cells.Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("A3:D8").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Sub a22222222()
Range("C10:E16").Select
ActiveSheet.Unprotect
Range("C10:E16").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("G10").Select
ActiveSheet.Unprotect
End Sub
_______________________________________
Excel 中另存为的程序
Sub saveas()
' saveas Macro
' Macro recorded 11/19/2008 by Zhu ShengQuan
ChDir "C:\Documents and Settings\U404680\Desktop"
ActiveWorkbook.saveas Filename:="C:\Documents and Settings\U404680\Desktop\265.mht", FileFormat:=xlWebArchive, CreateBackup:=False
End Sub
____________________________________________________
Private Sub CmdUpload_Click()
'This routine will upload the samples
'It check for a valid request nr
'if all required fields are filled in
'check for 100% percentages

'[check for connection]
Dim objConn As ADODB.Connection
Dim oConn As String
Dim sqlString As String
Dim Requestnr, NrofComponents As Integer
Dim KeyCell(1) As String
Dim rsRecordset As ADODB.Recordset
Dim IngRet, strUserId As String
Dim AddSample As Integer
Set objConn = New ADODB.Connection
Set rsRecordset = New ADODB.Recordset
'user is Fab_Upload and pw=Fab_Upload
'this login only has access to 3 tables
oConn = "DRIVER={SQL Server};SERVER=txnt116;UID=Fab_Upload;PWD=Fab_Upload;DATABASE=Fabrequest_SH"
'oConn = "DRIVER={SQL Server};SERVER=wsdevleo;UID=Fab_Upload;PWD=Fab_Upload;DATABASE=Fabrequest"

Worksheets("Formulations_%").Unprotect ("fabricrw")
Worksheets("Formulations_wt.").Unprotect ("fabricrw")
Worksheets("Materials").Unprotect ("fabricrw")

KeyCell(1) = "E4"
ActiveSheet.Range(KeyCell(1)).Select

'count nr of components, standard there are 23 (nrofcomponents-1)
For NrofComponents = 1 To 100
If ActiveCell.Offset(NrofComponents + 5, -3).Text = "Total Pellets" Then Exit For
Next NrofComponents

'MsgBox NrofComponents
'Exit Sub
'check if requestnr is a number
If Not IsNumeric(ActiveCell.Offset(0, 0).Text) Or ActiveCell.Offset(0, 0).Text = "" Then
MsgBox "The request # is not valid, please fill in a correct request #", vbCritical, "Error in Request #"
Exit Sub
Else
Requestnr = ActiveCell.Offset(0, 0).Text
ActiveCell.Offset(37 + (NrofComponents - 24), 4).Value = "Checking Request # in Fabrication Request System"
End If

'get the userid
strUserId = Space(7)
IngRet = GetUserName(strUserId, 10)

'sqlstring for requestnr check
sqlString = "Select Requestnr, EmployeeID FROM tblFabRequestMain Where StatusId IN ('I','C','O') and requestnr=" & Requestnr & " AND EmployeeID='" & strUserId & "';"

'On Error GoTo badconnection
objConn.Open oConn
rsRecordset.Open sqlString, objConn

If rsRecordset.EOF Or rsRecordset.BOF Then
MsgBox "The request # is not found in the system under your EmployeeID or the request is locked (only requests with a status of Incomplete, Complete or Onhold can be edited!)." & vbCrLf & "If locked you can not add samples through this sheet and you must enter them trough Fabrication Request System!", vbCritical, "Error in Request #"
Exit Sub
Else
ActiveCell.Offset(37 + (NrofComponents - 24), 4).Value = "Request # Verified"
End If

'check total amount, units, sample names and total amounts
'if a sample name has been supplied and the total amount=100% this is a valid sample. If not show msgbox
'first determine how many samples there are

Dim I As Integer
For I = 0 To 100
If ActiveCell.Offset(2, I).Text = "" And ActiveCell.Offset(34 + (NrofComponents - 24), I).Text = "" Then Exit For
Next I

'check for each sample the unit and total amount to be made and the total %
Dim X As Integer
For X = 0 To I - 1

'check total mount to be made
If ActiveCell.Offset(3, X).Text = "" Or Not IsNumeric(ActiveCell.Offset(3, X).Value) Then
MsgBox "The total amount to be made of sample " & ActiveCell.Offset(2, X).Text & " is missing or incorrect.", vbCritical, "Error in Sample Amount"
Exit Sub
End If
'check units
If ActiveCell.Offset(4, X).Text = "" Then
MsgBox "The unit of sample " & ActiveCell.Offset(2, X).Text & " is missing.", vbCritical, "Error in Unit."
Exit Sub
End If
'check total percentage
If Not IsNumeric(ActiveCell.Offset(34 + (NrofComponents - 24), X).Value) Or Not ActiveCell.Offset(34 + (NrofComponents - 24), X).Text = 100 Then
MsgBox "The total percentage is not equal to 100% for sample " & ActiveCell.Offset(2, X).Text & ". Pls correct.", vbCritical, "Error in %"
Exit Sub
End If

Next X

ActiveCell.Offset(37 + (NrofComponents - 24), 4).Value = "Samples Verified and prepare Upload"

CmdUpload.Enabled = False
CmdUpload.Caption = "UPLOADING...."
'upload the samples
For X = 0 To I - 1

'check if the sample was already uploaded
sqlString = "Select Sampledescr FROM tblSample WHERE Requestnr=" & Requestnr & " AND SampleDescr='" & ActiveCell.Offset(2, X).Text & "';"
rsRecordset.Close
rsRecordset.Open sqlString, objConn

If Not rsRecordset.BOF Or Not rsRecordset.EOF Then
'this means that the sampledescr is already in the assigned samples of the request
response = MsgBox("A Sample with the name " & ActiveCell.Offset(2, X).Text & " is already assigned to this request! Are you sure you want to upload this sample?", vbYesNo, "Name exists")

If response = vbYes Then
'all checks were succesfull we can upload
'first insert all samples
sqlString = "tblSample"
rsRecordset.Close
rsRecordset.Open sqlString, objConn, adOpenKeyset, adLockPessimistic, adCmdTable
rsRecordset.AddNew
rsRecordset("Requestnr") = Requestnr
rsRecordset("Sampledescr") = ActiveCell.Offset(2, X).Text
rsRecordset("Amount") = ActiveCell.Offset(3, X).Value
rsRecordset("Unit") = ActiveCell.Offset(4, X).Text
Select Case ActiveCell.Offset(4, X).Text
Case "Kg"
rsRecordset("AmountPounds") = ActiveCell.Offset(3, X).Value * 2.2
Case "g"
rsRecordset("AmountPounds") = (ActiveCell.Offset(3, X).Value / 1000) * 2.2
Case "Pounds"
rsRecordset("AmountPounds") = ActiveCell.Offset(3, X).Value
End Select
rsRecordset.Update

ActiveCell.Offset(1, X).Value = rsRecordset("SampleID")
AddSample = 1
Else
'do nothing
AddSample = 0
End If
Else
'all checks were succesfull we can upload
'first insert all samples
sqlString = "tblSample"
rsRecordset.Close
rsRecordset.Open sqlString, objConn, adOpenKeyset, adLockPessimistic, adCmdTable
rsRecordset.AddNew
rsRecordset("Requestnr") = Requestnr
rsRecordset("Sampledescr") = ActiveCell.Offset(2, X).Text
rsRecordset("Amount") = ActiveCell.Offset(3, X).Value
rsRecordset("Unit") = ActiveCell.Offset(4, X).Text
Select Case ActiveCell.Offset(4, X).Text
Case "Kg"
rsRecordset("AmountPounds") = ActiveCell.Offset(3, X).Value * 2.2
Case "g"
rsRecordset("AmountPounds") = (ActiveCell.Offset(3, X).Value / 1000) * 2.2
Case "Pounds"
rsRecordset("AmountPounds") = ActiveCell.Offset(3, X).Value
End Select
rsRecordset.Update

ActiveCell.Offset(1, X).Value = rsRecordset("SampleID")
AddSample = 1
End If

ActiveCell.Offset(37 + (NrofComponents - 24), 4).Value = "Sample " & ActiveCell.Offset(2, X).Text & " Uploaded"
'upload the percentages and materials to the tblFabComposition
'currently 23 components can be added
'
Dim ComponentName As String
Dim J As Integer

For J = 0 To NrofComponents - 2
If ActiveCell.Offset(6 + J, 0).Text > "" And AddSample = 1 Then
'check if a composition % is filled in for that component
'if not skip it
If ActiveCell.Offset(6 + J, X).Text > "" Then
sqlString = "tblFabComposition"
rsRecordset.Close
rsRecordset.Open sqlString, objConn, adOpenKeyset, adLockPessimistic, adCmdTable
rsRecordset.AddNew
rsRecordset("SampleID") = ActiveCell.Offset(1, X).Value
rsRecordset("Resin") = ActiveCell.Offset(6 + J, -3).Text
rsRecordset("GMID") = ActiveCell.Offset(6 + J, -2).Value
rsRecordset("LOTNR") = ActiveCell.Offset(6 + J, -1).Value
rsRecordset("Amount") = ActiveCell.Offset(6 + J, X).Value

Select Case ActiveCell.Offset(6 + J, -2).Text
Case "Pel", "Pellets"
rsRecordset("ResinType") = "Pellets"
Case "Pow", "Powders"
rsRecordset("ResinType") = "Powders"
Case "Liq", "Liquids"
rsRecordset("ResinType") = "Liquids"
Case "Oth", "Other"
rsRecordset("ResinType") = "Other"
Case "Fil", "Fillers"
rsRecordset("ResinType") = "Fillers"
End Select

rsRecordset.Update
End If

End If
Next J

ActiveCell.Offset(37 + (NrofComponents - 24), 4).Value = "Composition of Sample " & ActiveCell.Offset(2, X).Text & " Uploaded "

Next X

MsgBox "Upload completed!"
ActiveCell.Offset(37 + (NrofComponents - 24), 4).Value = "Upload Complete"

CmdUpload.Enabled = True
CmdUpload.Caption = "Upload Sample to Fabrication Request System"

rsRecordset.Close
objConn.Close
Set objConn = Nothing
Set rsRecordset = Nothing

Worksheets("Formulations_%").Protect ("fabricrw")
Worksheets("Formulations_wt.").Protect ("fabricrw")
Worksheets("Materials").Protect ("fabricrw")

Exit Sub

badconnection:

Worksheets("Formulations_%").Protect ("fabricrw")
Worksheets("Formulations_wt.").Protect ("fabricrw")
Worksheets("Materials").Protect ("fabricrw")

MsgBox "The connection to the Fabrication Request System has been lost. Upload cancelled", vbCritical, "Connection Error"
objConn.Close
Set objConn = Nothing
Set rsRecordset = Nothing
End Sub
___________________________________-
Option Explicit

Private Sub Form_Click()
Dim a As Integer, b As Integer
a = 5
b = 6
Try a, b
Debug.Print "a="; a, "b="; b
End Sub

Private Sub Try(ByVal x As Integer, ByVal y As Integer)
x = x + 2
y = y + 2
Debug.Print "x="; x, "y="; y
End Sub
_______________________
我在我的 textbox 里输入文字 ，我鼠标点到哪儿 光标就插到哪儿,
有没 有方法 可以使我鼠标点后 光标 靠左,我是想如果 我里面有字 光标就在字后面 ,如果没有 就在最左边 这样有办法没
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.SelStart = 0
End Sub
Private Sub Text1_Click()
If Len(Text1.Text) <> 0 Then
Text1.SelStart = Len(Text1.Text)
End If
End Sub
_______________________________
编制一个排序的函数，对任意一组数进行从大到小排序。请在界面上分别输出排序前和排序后的数据，界面自定。
_________________________________
题目1.设计并完成一个过程Split（ByVal data As Decimal），能将参数data进行按比例拆分，data值的40%送给Label控件Lb1的文本属性，而将data值的60%送给Label1控件的Lb2的文本属性
题目2.设计并完成一个函数Getmin（ByVal x1 As Decimal,ByVal x2 As Decimal),函数的返回值是一个字符串，其内容是两个参数较小ide变量名（x1或x2）
题目3.设计并完成1平方/2+2平方/2+3平方/2......10平方/2的累加值，结果送至变量Sum
_________________________________
求用vb对这题进行编程的过程
求区间[200，3000]中所有回文数的和，回文数是正读反读都一样的数，如525，1551.
急！！！！！！！！！！！！！！
Private Sub cmd202_Click()
Dim xN, xSum, m As Integer
Dim n As Long
xSum = 0
For xN = 200 To 1000
If Left(xN, 1) = Right(xN, 1) Then
xSum = xSum + xN
End If
Next
For xN = 1000 To 3000
If Left(xN, 1) = Right(xN, 1) And Left(xN, 2) = Right(xN, 2) Then
xSum = xSum + xN

End If
Next
MsgBox (xSum)
End Sub

_________________________________

Answer 3

参考答案 我和超人唯一的区别就是我把内裤穿里边了