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

[khaledhelmy]

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

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

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

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

HIDDEN.rar

[Elsayed Bn Gemy]

هل هذا ما تريد اخى الكريم

HIDDEN.rar

[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

[khaledhelmy]

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

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

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

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

[Elsayed Bn Gemy]

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

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

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

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

 

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

 

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

[yms12]

اخي مارد

انت متالق مشاء الله

[yms12]

اخي مارد

جربت المرفق بالفعل يقوم باخفاء الاستعلامات ولكن زر اضهار الاستعلام لا يعمل

[ابو جودي]

شوف ده مثال شامل وجامع 

 

إخفاء واظهار الجداول والكائنات.rar

[khaledhelmy]

شكرا الأخ العزيز / محمد عصام

مثال هائل وشامل فعلاً

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

[ابو جودي]

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

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

[khaledhelmy]

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

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

[ابو جودي]

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

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

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

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

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

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

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

 

[kaser906]

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

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

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

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

[ابو جودي]

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

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

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

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

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

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

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

[ابو جودي]

ده مثال لاظهار واخفاء جميع كائنات الاكسس بما فى ذلك الجداول المرتبطه

إخفاء جميع كائنات أكسس.rar

[moustafa2004]

شكرا على المجهود الرائع

 

[moustafa2004]

شكرا جزيلا وربنا يبارك فيك

لي سؤال في الاكسل عاوز امسح مجموعة خلايا في تاريخ محدد بالكود

[عبدالقدوس48]

هل تعمل مع أكسيس 2010