Nazir Ahmad
پنج شنبه 19 فروردین 1395, 10:28 صبح
سلام
تو تالار تاپیک های زیادی در باره تغییر رنگ و تم برنامه وجود داره اما متاسفانه هیچکدوم کامل نیست.
چطوری میشه تم کل برنامه (فرم ها و گزارشات) رو مانند دستور Themes خود اکسس تغییر داد.
منظورم مثل عکس ضمیمه است.
البته با کلی گشتن یه کد پیدا کردم اما نتونستم ازش استفاده کنم و ارور میده
Function SveThm() 'Save Theme Dim MSR As Recordset, Atc As Recordset, LR As Recordset
Set MSR = CurrentDb.OpenRecordset("SELECT * FROM MSysResources WHERE [Name]='Office Theme'", dbOpenDynaset)
If MSR.RecordCount > 0 Then
Set Atc = MSR!Data.Value
Set LR = CurrentDb.OpenRecordset("SELECT * FROM tbllgo;", dbOpenDynaset)
If LR.RecordCount = 0 Then LR.AddNew Else LR.Edit
LR!Stn = LgoStn
LR!Lgo = CStr(Atc!FileData)
LR!Typ = Typ
LR.Update
LR.Close
MsgBox "Your theme has been saved."
End If
End Function
Function SetMSys() 'Set MSysResources
Dim MSys As Recordset, Lgo As Recordset, Atc As Recordset
Set MSys = CurrentDb.OpenRecordset("SELECT * FROM MSysResources WHERE [Name]='Office Theme'", dbOpenDynaset)
If MSys.RecordCount > 0 Then
MSys.Edit
Set Atc = MSys!Data.Value
Atc.Edit
Set Lgo = CurrentDb.OpenRecordset("SELECT Lgo FROM tbllgo;", dbOpenDynaset)
If Lgo.RecordCount > 0 Then Atc!FileData = Lgo!Lgo
Lgo.Close
Atc.Update
MSys.Update
End If
End Function
ممنون
یا حق
تو تالار تاپیک های زیادی در باره تغییر رنگ و تم برنامه وجود داره اما متاسفانه هیچکدوم کامل نیست.
چطوری میشه تم کل برنامه (فرم ها و گزارشات) رو مانند دستور Themes خود اکسس تغییر داد.
منظورم مثل عکس ضمیمه است.
البته با کلی گشتن یه کد پیدا کردم اما نتونستم ازش استفاده کنم و ارور میده
Function SveThm() 'Save Theme Dim MSR As Recordset, Atc As Recordset, LR As Recordset
Set MSR = CurrentDb.OpenRecordset("SELECT * FROM MSysResources WHERE [Name]='Office Theme'", dbOpenDynaset)
If MSR.RecordCount > 0 Then
Set Atc = MSR!Data.Value
Set LR = CurrentDb.OpenRecordset("SELECT * FROM tbllgo;", dbOpenDynaset)
If LR.RecordCount = 0 Then LR.AddNew Else LR.Edit
LR!Stn = LgoStn
LR!Lgo = CStr(Atc!FileData)
LR!Typ = Typ
LR.Update
LR.Close
MsgBox "Your theme has been saved."
End If
End Function
Function SetMSys() 'Set MSysResources
Dim MSys As Recordset, Lgo As Recordset, Atc As Recordset
Set MSys = CurrentDb.OpenRecordset("SELECT * FROM MSysResources WHERE [Name]='Office Theme'", dbOpenDynaset)
If MSys.RecordCount > 0 Then
MSys.Edit
Set Atc = MSys!Data.Value
Atc.Edit
Set Lgo = CurrentDb.OpenRecordset("SELECT Lgo FROM tbllgo;", dbOpenDynaset)
If Lgo.RecordCount > 0 Then Atc!FileData = Lgo!Lgo
Lgo.Close
Atc.Update
MSys.Update
End If
End Function
ممنون
یا حق