اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود إخفاء وإظهار الإستعلامات

khaledhelmy

بواسطه khaledhelmy
في قسم الأكسيس Access

 مشاركة
إذهب إلى أفضل إجابة Solved by ابو جودي,

الردود الموصى بها

khaledhelmy

khaledhelmy

قام بنشر
قام بنشر

إخوانى من فضلكم

مرفق مثال به نموذج يحتوى على عدد 2 زرار الأول يقوم بإخفاء الإستعلامات والأخر يقوم بإظهارهم مرة أخرى ولكن الكود الموجود فى محرر الفيجوال لا يعمل.

ممكن المساعدة فى الكود أو تعديله لكى يعمل بشكل صحيح

وشكراً وجزاكم الله كل خير

HIDDEN.rar

رابط هذا التعليق
شارك
Elsayed Bn Gemy

Elsayed Bn Gemy

قام بنشر
قام بنشر

اخى يمكنك مراجعة هذا الرابط

 

منتديات الدعم من مطورى الاكسس ميكروسوفت

 

https://social.msdn.microsoft.com/Forums/office/en-US/25d9dafd-b446-40ba-8dbd-a0efa983f2ff/how-to-programatically-hide-a-querydef?forum=accessdev

    Const strcQueryName As String = "QueryName"
   
    Dim fIsHidden As Boolean
   
    '   To determine if the query is hidden:
    fIsHidden = GetHiddenAttribute(acQuery, strcQueryName)
    Debug.Print fIsHidden
   
    '   To show the query:
    SetHiddenAttribute acQuery, strcQueryName, False
   
    '   To hide the query:
    SetHiddenAttribute acQuery, strcQueryName, True
  • Like 1
رابط هذا التعليق
شارك
khaledhelmy

khaledhelmy

قام بنشر
  • الكاتب
قام بنشر

شكراً جزيلاً الأخ مارد

الكود تمام وشغال ولكن تبقى مشكلة واحدة وهى ان الكود يقوم بإخفاء إستعلام واحد فقط وفقاً لما أحدد أنا أسم الإستعلام

والمطلوب من فضلك اننى عند الضغط على زرار إخفاء يقوم بإخفاء الأستعلامات جميعاً بدلاً من أقوم بتحديد كل إستعلام على حدة فى الكود

وشكراً جزيلاً وجزاك الله كل خير

رابط هذا التعليق
شارك
Elsayed Bn Gemy

Elsayed Bn Gemy

قام بنشر
قام بنشر

شكراً جزيلاً الأخ مارد

الكود تمام وشغال ولكن تبقى مشكلة واحدة وهى ان الكود يقوم بإخفاء إستعلام واحد فقط وفقاً لما أحدد أنا أسم الإستعلام

والمطلوب من فضلك اننى عند الضغط على زرار إخفاء يقوم بإخفاء الأستعلامات جميعاً بدلاً من أقوم بتحديد كل إستعلام على حدة فى الكود

وشكراً جزيلاً وجزاك الله كل خير

 

الكود الاخير هو الذى يقوم باخفاء كل استعلام على حدا

 

اما لو نظرت الى المرفق فستجده يخفى كل الاستعلامات

رابط هذا التعليق
شارك
ابو جودي

ابو جودي

قام بنشر
قام بنشر

ولكن ينقصه أنه غير مفتوح للسورس كود ؟
ازاى
اومال ده ايه ؟

Option Compare Database



Private Sub Command27_Click()
Dim msg, style, title, result
msg = "ÓíÊã ÊæÞíÝ ÇáÔíÝÊ"
style = vbYesNo
title = " ÊÍÐíÑ - ÅíÞÇÝ ãÝÊÇÍ"
result = MsgBox(msg, style, title)
If result = vbYes Then
ChangeProperty "AllowBypassKey", DB_BOOLEAN, False
 MsgBox "Êã ÅíÞÇÝ ÇáÔíÝÊ", vbInformation, "ÅÊãÇã ÇáÚãáíÉ"
ElseIf result = vbNo Then
DoCmd.CancelEvent
 MsgBox "Êã ÇáÊÑÌÚ Úä ÇíÞÇÝ ÇáÔíÝÊ", vbInformation, "ÅáÛÇÁ ÇáÚãáíÉ"
End If
End Sub

Private Sub Command28_Click()
Dim msg, style, title, result
msg = "ÓíÊã ÊÝÚíá ÇáÔíÝÊ"
style = vbYesNo
title = " ÊÍÐíÑ - ÅíÞÇÝ ãÝÊÇÍ"
result = MsgBox(msg, style, title)
If result = vbYes Then
ChangeProperty "AllowBypassKey", DB_BOOLEAN, True
 MsgBox "Êã ÊÝÚíá ÇáÔíÝÊ ", vbInformation, "ÅÊãÇã ÇáÚãáíÉ"
ElseIf result = vbNo Then
DoCmd.CancelEvent
 MsgBox "Êã ÇáÊÑÌÚ Úä ÊÝÚíá ÇáÔíÝÊ", vbInformation, "ÅáÛÇÁ ÇáÚãáíÉ"
End If
End Sub

Private Sub ÅÎÝÇÁ_ÇáÊÞÇÑíÑ_Click()
On Error Resume Next

Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllReports
SetHiddenAttribute acReport, obj.Name, True
Next obj
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0

End Sub

Private Sub ÅÎÝÇÁ_ÇáãÇßÑæÇÊ_Click()
On Error Resume Next

Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllMacros
SetHiddenAttribute acMacro, obj.Name, True
Next obj
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0

End Sub

Private Sub ÅÎÝÇÁ_ÇáäãÇÐÌ_Click()
On Error Resume Next
DoCmd.Close
Dim db As Database

Dim obj As AccessObject
Set dbs = Application.CurrentProject
For Each obj In dbs.AllForms
SetHiddenAttribute acForm, obj.Name, True
Next obj
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0
DoCmd.OpenForm "mainfrm"

End Sub


Private Sub ÅÎÝÇÁ_ÇáæÍÏÇÊ_Click()
On Error Resume Next

Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllModules
SetHiddenAttribute acModule, obj.Name, True
Next obj
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0

End Sub

Private Sub ÅÙåÇÑ_ÇáÊÞÇÑíÑ_Click()
Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllReports
SetHiddenAttribute acReport, obj.Name, False
Next obj

End Sub

Private Sub ÅÙåÇÑ_ÇáãÇßÑæÇÊ_Click()
On Error Resume Next

Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllMacros
SetHiddenAttribute acMacro, obj.Name, False
Next obj
End Sub

Private Sub ÅÙåÇÑ_ÇáäãÇÐÌ_Click()
On Error Resume Next
DoCmd.Close


Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllForms
SetHiddenAttribute acForm, obj.Name, False
Next obj
DoCmd.OpenForm "mainfrm"

End Sub


Private Sub ÅÎÝÇÁ_ãÚ_ÅÙåÇÑ_ÈÇáÎíÇÑÇÊ_Click()
Dim obj As AccessObject, dbs As Object

Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
If Left(obj.Name, 4) <> "MSys" Then SetHiddenAttribute acTable, obj.Name, True
Next obj
End Sub

Private Sub ÅÎÝÇÁ_ãÚ_ÚÏã_ÅÙåÇÑåÇ_ÈÇáÎíÇÑÇÊ_Click()
Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim tdf As TableDef

Set dbs = Application.CurrentData
Set db = CurrentDb

For Each obj In dbs.AllTables
Set tdf = db.TableDefs(obj.Name)
If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then
tdf.Attributes = tdf.Attributes + dbHiddenObject
End If
Next
  
Set tbl = Nothing
db.Close
Set db = Nothing

End Sub

Private Sub ÅÙåÇÑ_ÇáæÍÏÇÊ_Click()
On Error Resume Next

Dim obj As AccessObject
Dim dbs As Object
Set dbs = Application.CurrentProject
For Each obj In dbs.AllModules
SetHiddenAttribute acModule, obj.Name, False
Next obj
End Sub

Private Sub ÅÙåÇÑ_ãÚ_ÅÎÝÇÆåÇ_ÈÇáÎíÇÑÇÊ_Click()
Dim obj As AccessObject, dbs As Object

Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
If Left(obj.Name, 4) <> "MSys" Then SetHiddenAttribute acTable, obj.Name, False
Next obj
End Sub


Private Sub ÅÙåÇÑ_ãÚ_ÚÏã_ÅÙåÇÑåÇ_ÈÇáÎíÇÑÇÊ_Click()
Dim dbs As Database, tdf As TableDef
    
    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _
    And tdf.Attributes = 1 Then
            tdf.Attributes = tdf.Attributes - dbHiddenObject
    End If
    Next tdf
    Set dbs = Nothing
End Sub

Private Sub ÃãÑ14_Click()
On Error GoTo Err_ÃãÑ14_Click


    DoCmd.Close

Exit_ÃãÑ14_Click:
    Exit Sub

Err_ÃãÑ14_Click:
    MsgBox Err.Description
    Resume Exit_ÃãÑ14_Click
    
End Sub
Private Sub ÃãÑ16_Click()
Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim tdf As TableDef
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, True
Next obj
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0
Set tdf = Nothing
db.Close
Set db = Nothing
    
End Sub
Private Sub ÃãÑ17_Click()
 Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, False
Next obj
Set tdf = Nothing
db.Close
Set db = Nothing

End Sub

Private Sub ÃãÑ18_Click()
Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim tdf As TableDef
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllTables
Set tdf = db.TableDefs(obj.Name)
If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then
tdf.Attributes = tdf.Attributes + dbHiddenObject
End If
Next
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, True
Next obj
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0
Set tdf = Nothing
db.Close
Set db = Nothing

End Sub
Private Sub ÃãÑ20_Click()
Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim tdf As TableDef
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllTables
Set tdf = db.TableDefs(obj.Name)
If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then
tdf.Attributes = tdf.Attributes + dbHiddenObject
End If
Next
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, True
Next obj
DoCmd.Close

Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0
Set tdf = Nothing
db.Close
Set db = Nothing


    
End Sub


Function hiddenobj()
    Dim obj As AccessObject
Dim dbs As Object
Dim qry As QueryDefs
Set db = CurrentDb

Set dbs = Application.CurrentProject
For Each obj In dbs.AllReports
SetHiddenAttribute acReport, obj.Name, True
Next obj
For Each obj In dbs.AllMacros
SetHiddenAttribute acMacro, obj.Name, True
Next obj
For Each obj In dbs.AllModules
SetHiddenAttribute acModule, obj.Name, True
Next obj
DoCmd.Close
For Each obj In dbs.AllForms
SetHiddenAttribute acForm, obj.Name, True
Next obj

Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0

End Function
Function TQ_hidden()
Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim tdf As TableDef
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllTables
Set tdf = db.TableDefs(obj.Name)
If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then
tdf.Attributes = tdf.Attributes + dbHiddenObject
End If
Next
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, True
Next obj

Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0
Set tdf = Nothing
db.Close
Set db = Nothing

End Function

Private Sub ÃãÑ21_Click()
Call hiddenobj
Call TQ_hidden
DoCmd.OpenForm "mainfrm"

End Sub

Function TQshow()
 Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, False
Next obj
    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _
    And tdf.Attributes = 1 Then
            tdf.Attributes = tdf.Attributes - dbHiddenObject
    End If
    Next tdf
    Set dbs = Nothing

db.Close
Set db = Nothing

End Function

Function objshow()
    Dim obj As AccessObject
Dim dbs As Object
Dim qry As QueryDefs
Set db = CurrentDb

Set dbs = Application.CurrentProject
For Each obj In dbs.AllReports
SetHiddenAttribute acReport, obj.Name, False
Next obj
For Each obj In dbs.AllMacros
SetHiddenAttribute acMacro, obj.Name, False
Next obj
For Each obj In dbs.AllModules
SetHiddenAttribute acModule, obj.Name, False
Next obj
DoCmd.Close
For Each obj In dbs.AllForms
SetHiddenAttribute acForm, obj.Name, False
Next obj

End Function

Private Sub ÃãÑ23_Click()
Call objshow
Call TQshow
DoCmd.OpenForm "mainfrm"
End Sub

Private Sub ÃãÑ24_Click()
 Dim db As Database
Dim obj As AccessObject, dbs As Object
Dim qry As QueryDefs
Set dbs = Application.CurrentData
Set db = CurrentDb
For Each obj In dbs.AllQueries
SetHiddenAttribute acQuery, obj.Name, False
Next obj
    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _
    And tdf.Attributes = 1 Then
            tdf.Attributes = tdf.Attributes - dbHiddenObject
    End If
    Next tdf
    Set dbs = Nothing

db.Close
Set db = Nothing


End Sub



Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant)
Dim dbs, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
ChangeProperty = False
Resume Change_Bye
End If
End Function
رابط هذا التعليق
شارك
  • أفضل إجابة
ابو جودي

ابو جودي

قام بنشر
  • أفضل إجابة
قام بنشر

طيب ع العموم استنى 
المرفق اهو انا اسف انا كنت لاغى القوائم 
كل الاكواد داخل الفورم mainfrm
إخفاء واظهار الجداول والكائنات.rar

  • Like 2
رابط هذا التعليق
شارك
ابو جودي

ابو جودي

قام بنشر
قام بنشر

شكراً جزيلاً أخى العزيز

وجزاك الله كل خير

الحمد لله كما ينبغى لجلال وجهه ولعظيم سلطانه الحمد لله الذى بنعمته تتم الصالحات

لا شكر على واجب :yes: 

ثم ان الفضل يرجع لله اولا سبحانه وتعالى ثم لاساتذتنا الكرام فى هذا الصرح الشامخ فمنهم اتعلم وبهم اقتضى :yes:  :yes: 

ولولا الفضل الله سبحانه وتعالى اولا ثم اساتذتنا الكرام لما استطعت عمل هذا المثال  :yes: 

جزا الله اساتذتنا الكرام واياكم خير الجزاء  :fff:  :fff:  :fff: 

 

  • Like 1
رابط هذا التعليق
شارك
ابو جودي

ابو جودي

قام بنشر
قام بنشر

مع التحية / للاستاذ محمد

نموذج شامل رائع

يعاب علية فقط عدم امكانية اخفاء الجداول المرتبطة

هل يمكن تعديله  لاخفاء الجداول المرتبطة

اولا لست بأستاذ انا مجرد طالب علم فقط بل اقل طالب علم فى هذا الصرح الشامخ 

ثانيا جزاكم الله خيرا 

وبالنسبه للعيب لعدم احتواء المثال على الجداول المرتبطه جارى التعديل والاضافه للأكواد الخاصة بإظهار وإخفاء الجداول المرتبطه

رابط هذا التعليق
شارك
  • 4 years later...
  • 2 months later...
  • 2 years later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept