سلام
با استفاده از كدهاي زير شما قادر به تغيير Caption فيلد هاي جداولتون خواهيد بود :
اين كدها رو در يك ماجول جديد كپي كنيد :
Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As _
Integer, varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
If HasProperty(obj, strPropertyName) Then
obj.Properties(strPropertyName) = varValue
Else
obj.Properties.Append obj.CreateProperty(strPropertyName, intType, _
varValue)
End If
SetPropertyDAO = True
ExitHandler:
Exit Function
ErrHandler:
strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to" _
& varValue & ". Error " & Err.Number & " - " & Err.Description & vbCrLf
Resume ExitHandler
End Function
Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function
در مرحله بعدي يك فرم ايجاد كنيد و يك كامند باتون روي اون بذاريد تحت نام cmdChangeCapt و كدهاي زير رو در رخداد On Click اون كپي كنيد :
Private Sub CmdChangeCapt_Click()
On Error GoTo Err_CmdChangeCapt_Click
Dim TbName, FldName, StrCaption As String
TbName = InputBox("نام جدول مورد نظر را وارد نمائيد", "نام جدول")
FldName = InputBox("نام فيلد مورد نظر را وارد نمائيد", "نام فيلد")
StrCaption = InputBox("عنوان برچسب را وارد نمائيد", "عنوان برچسب")
If IsNull(StrCaption) Or StrCaption = "" Then
If MsgBox("عنوان برچسب فيلد تعيين نشده است" & vbCrLf & _
"آيا مايل به تعيين عنوان برچسب هستيد ؟", _
vbExclamation + vbMsgBoxRight + vbRetryCancel, "توجه") = vbCancel Then
Call SetPropertyDAO(CurrentDb.TableDefs(TbName).Fields( FldName), _
"Caption", dbText, StrCaption)
Else
StrCaption = InputBox("عنوان برچسب را وارد نمائيد", "عنوان برچسب")
Call SetPropertyDAO(CurrentDb.TableDefs(TbName).Fields( FldName), _
"Caption", dbText, StrCaption)
End If
End If
Exit_CmdChangeCapt_Click:
Exit Sub
Err_CmdChangeCapt_Click:
If Err.Number = 3265 Then
MsgBox "نام جدول يا نام فيلد وارد شده معتبر نيست", _
vbCritical + vbMsgBoxRight, "خطا"
Else
MsgBox Err.Description
Resume Exit_CmdChangeCapt_Click
End If
End Sub
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول