أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
محمدعبدالسلام لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة طلب مساعدة اريد في كل 4 من شهر يتم نسح الاسم من عمود الى عمود اكسيل اسئله واجابات


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





كود اخفاء الملف و اظهار الفورم فقط

السلام عليكم استخدمت هذا الكود لأجل اظهار اليوزرفورم فقط و اخفاء ملف العمل فقط في حالة فتح عدة ملفات لا يختفي الا هذا ال ..


موضوع مغلق


15-10-2020 03:06 مساء
ANASS1
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-04-2018
رقم العضوية : 5696
المشاركات : 48
الجنس : ذكر
تاريخ الميلاد : 22-1-1990
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 46
 offline 

السلام عليكم
استخدمت هذا الكود لأجل اظهار اليوزرفورم فقط و اخفاء ملف العمل فقط
في حالة فتح عدة ملفات لا يختفي الا هذا الملف فقط
المرجو منكم مراجعة هذا الكود , هل هو فعال لما اريد ؟
شكرا لكم
ThisWorkbook
Option Explicit

Public WithEvents AppXL As Application

Private Sub AppXL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Application.Workbooks.Count = 2 Then
  Application.Visible = False
  If UserFormVisible = False Then UserForm1.Show vbModeless
Else
  ThisWorkbook.Windows(1).Visible = False
End If
End Sub

UserForm
Private Sub UserForm_Initialize()
UserFormVisible = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim FM

If Application.Workbooks.Count = 1 Then
  If Application.Visible = False Then
    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
      ThisWorkbook.Save
      'ThisWorkbook.Close
      Application.Quit
     Else
       Cancel = True
    End If
  End If
 Else
 If Application.Visible = True Then
    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
      ThisWorkbook.Save
      ThisWorkbook.Close
     Else
       Cancel = True
    End If
  End If
End If
End Sub

Module
Option Explicit

Public AppClass As New Classe1
Public UserFormVisible As Boolean

Classmodul
Option Explicit

Public WithEvents AppXL As Application

Private Sub AppXL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Application.Workbooks.Count = 2 Then
  Application.Visible = False
  If UserFormVisible = False Then UserForm1.Show vbModeless
Else
  ThisWorkbook.Windows(1).Visible = False
End If
End Sub

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  1.xlsm   تحميل xlsm مرات التحميل :(14)
الحجم :(19.3) KB



أفضل إجابة مقدمة من hassona229 وهي:
جرب هذا التعديل
وعليكم السلام ورحمه الله وبركاته

ThisWorkbook

Option Explicit
Private Sub Workbook_Open()

    If Windows(ThisWorkbook.Name).Visible = True Then Windows(ThisWorkbook.Name).Visible = False
        Set AppClass.AppXL = Application
    If Application.Workbooks.Count = 1 Then
Application.Visible = False
        Windows(ThisWorkbook.Name).Visible = False
    Else
        Windows(ThisWorkbook.Name).Visible = False
    End If
UserForm1.Show vbModeless

End Sub

UserForm

Private Sub CommandButton1_Click()
Windows(ThisWorkbook.Name).Visible = True

End Sub

Private Sub UserForm_Initialize()
UserFormVisible = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim FM

If Application.Workbooks.Count = 1 Then
If Windows(ThisWorkbook.Name).Visible = False Then
    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
      ThisWorkbook.Save
      'ThisWorkbook.Close
      Application.Quit
     Else
       Cancel = True
    End If
  End If
 Else
 If Application.Visible = True Then

    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
      ThisWorkbook.Save
      ThisWorkbook.Close
     Else
       Cancel = True
    End If
  End If
End If
End Sub

Classmodul
Option Explicit
Public WithEvents AppXL As Application
Private Sub AppXL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Application.Workbooks.Count = 2 Then
  Windows(ThisWorkbook.Name).Visible = False
  If UserFormVisible = False Then UserForm1.Show vbModeless
Else
  Windows(ThisWorkbook.Name).Visible = False
End If
End Sub

 
عرض الإجابة




19-10-2020 04:01 صباحا
مشاهدة مشاركة منفردة [1]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif كود اخفاء الملف و اظهار الفورم فقط
جرب هذا التعديل
وعليكم السلام ورحمه الله وبركاته

ThisWorkbook

Option Explicit
Private Sub Workbook_Open()

    If Windows(ThisWorkbook.Name).Visible = True Then Windows(ThisWorkbook.Name).Visible = False
        Set AppClass.AppXL = Application
    If Application.Workbooks.Count = 1 Then
Application.Visible = False
        Windows(ThisWorkbook.Name).Visible = False
    Else
        Windows(ThisWorkbook.Name).Visible = False
    End If
UserForm1.Show vbModeless

End Sub

UserForm

Private Sub CommandButton1_Click()
Windows(ThisWorkbook.Name).Visible = True

End Sub

Private Sub UserForm_Initialize()
UserFormVisible = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim FM

If Application.Workbooks.Count = 1 Then
If Windows(ThisWorkbook.Name).Visible = False Then
    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
      ThisWorkbook.Save
      'ThisWorkbook.Close
      Application.Quit
     Else
       Cancel = True
    End If
  End If
 Else
 If Application.Visible = True Then

    FM = MsgBox(prompt:=" " & vbLf & _
    "Voulez-vous réellement fermer ?", Buttons:=vbOKCancel)
    If FM = vbOK Then
      If Not AppClass Is Nothing Then Set AppClass = Nothing
      ThisWorkbook.Save
      ThisWorkbook.Close
     Else
       Cancel = True
    End If
  End If
End If
End Sub

Classmodul
Option Explicit
Public WithEvents AppXL As Application
Private Sub AppXL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Application.Workbooks.Count = 2 Then
  Windows(ThisWorkbook.Name).Visible = False
  If UserFormVisible = False Then UserForm1.Show vbModeless
Else
  Windows(ThisWorkbook.Name).Visible = False
End If
End Sub

 

19-10-2020 12:53 مساء
مشاهدة مشاركة منفردة [2]
ANASS1
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-04-2018
رقم العضوية : 5696
المشاركات : 48
الجنس : ذكر
تاريخ الميلاد : 22-1-1990
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 46
 offline 
look/images/icons/i1.gif كود اخفاء الملف و اظهار الفورم فقط
السلام عليكم
شكرا جزيلا استاذ  hassona229  على الاهتمام 
واجهني مشكلتين في حالة فتح الملف وحده اي لا يوجد ملف اخر مفتوح 
الاولى في النافذة التي تظهر وراء اليوزرفورم و الثانية لايمكن فتح اي ملف اخر بعد فتح  الفروم وحده 
جزاك الله خيرا استاذ
QLCsL_Sans titre
 
 


12-11-2020 12:24 صباحا
مشاهدة مشاركة منفردة [3]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif كود اخفاء الملف و اظهار الفورم فقط
تم التعديل في المشاركة السابقه لعلها تلبي طلبك ان شاء الله




الكلمات الدلالية
اخفاء ، مراجة ، الملف ، اظهار ، الفورم ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 07:21 مساء