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

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

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز
المشرف المتميز
المراقب المتميز
المدير المتميز
الموضوع المتميز
القسم المتميز
بكار للأبد Eslam Abdullah لا تميز خلال هذه الفترة YasserKhalil اصدار حديث به كل جديد كنترول 2019 اكسيل اسئله واجابات




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





عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا

السلام عليكم اتمنى الاجابه من حضراتكم ايها الاعزاء اريد جزء من الفورم يظهر فيه شيت الاكسل الذي اعمل عليه حيث انني استخد ..



14-09-2017 12:30 مساء
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 

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






14-09-2017 03:26 مساء
مشاهدة مشاركة منفردة [1]
جعفر الطريبق
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 14-09-2017
رقم العضوية : 477
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 19-4-1968
يتابعهم : 0
يتابعونه : 6
قوة السمعة : 95
الاعجاب : 30
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
السلام عليكم 

ممكن فعل هذا بواسطة ال APIs .. أتمنى أن يشتغل لديك .. تم اضافة Frame Control الى الفورم حيث ستظهر صورة الشيت .. المرجو معاينة الملف المرفق.

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

كود في موديول الفورم
Option Explicit

Private WithEvents wb As Workbook

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Private Type uPicDesc
    Size As Long
    Type As Long
    #If VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    #Else
        hPic As Long
        hPal As Long
    #End If
End Type

#If VBA7 Then
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
    Private hPtr As LongPtr
#Else
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Private hPtr As Long
#End If
 
Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1
  

Private Sub UserForm_Activate()
    Set wb = ThisWorkbook
    Call UpdatePic
End Sub

Private Sub wb_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call UpdatePic
End Sub

Private Sub UpdatePic()
    Dim oCopiedRange As Range
    
    Set oCopiedRange = ActiveWindow.VisibleRange '<== change this range as required.
    With Me.Frame1
        .ScrollBars = fmScrollBarsBoth
        .ScrollWidth = oCopiedRange.Width
        .ScrollHeight = oCopiedRange.Height
        .PictureAlignment = fmPictureAlignmentCenter
        Set .Picture = CreateRangePic(oCopiedRange)
    End With

End Sub

  
Private Function CreateRangePic(ByVal Rng As Range) As IPictureDisp
         
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    
    On Error GoTo errHandler
    
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPtr
        .hPal = 0
    End With
    OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
    Set CreateRangePic = IPic
errHandler:
    CloseClipboard
End Function


 


تم تحرير المشاركة بواسطة :جعفر الطريبق
بتاريخ:14-09-2017 03:30 مساء


أثارت هذه المشاركة إعجاب: ابو يوسف المصري، حسين مامون، الصقر، Yasser Elaraby، YasserKhalil، arsalanamin، Salamco، محمد النيل،




14-09-2017 08:22 مساء
مشاهدة مشاركة منفردة [2]
محمد الدسوقى
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 451
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 54
يتابعهم : 8
يتابعونه : 369
قوة السمعة : 5206
الاعجاب : 1077
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
أستاذ ى المبدع / جعفر
بارك الله فيك
كود رائع جدا ، زادك الله علما
تقبل تحياتى





15-09-2017 10:50 صباحا
مشاهدة مشاركة منفردة [3]
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
جزاك الله خيرا وبوركت استاذ جعفر





15-09-2017 01:53 مساء
مشاهدة مشاركة منفردة [4]
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
الاستاذ جعفر المحترم
عندما اريد ان اغير الشيت الى شيت اخر من خلال الفورم 
هل استطيع مشاهدتة على الفورم لان هذا الكود يعمل فقط على اول شيت وعند تغيير الشيت لايظهر الشيت الجديد على الفورم
تحياتي





15-09-2017 05:36 مساء
مشاهدة مشاركة منفردة [5]
جعفر الطريبق
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 14-09-2017
رقم العضوية : 477
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 19-4-1968
يتابعهم : 0
يتابعونه : 6
قوة السمعة : 95
الاعجاب : 30
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
السلام عليكم


جرب هذا الكود في موديول الفورم :
Option Explicit

Private WithEvents wb As Workbook

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Private Type uPicDesc
    Size As Long
    Type As Long
    #If VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    #Else
        hPic As Long
        hPal As Long
    #End If
End Type

#If VBA7 Then
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
    Private hPtr As LongPtr
#Else
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Private hPtr As Long
#End If
 
Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1
  

Private Sub UserForm_Activate()
    Set wb = ThisWorkbook
    Call UpdatePic
End Sub

Private Sub wb_WindowActivate(ByVal Wn As Window)
    Call UpdatePic
End Sub

Private Sub wb_SheetActivate(ByVal Sh As Object)
    Call UpdatePic
End Sub

Private Sub wb_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Call UpdatePic
End Sub

Private Sub wb_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call UpdatePic
End Sub

Private Sub UpdatePic()
    Dim oCopiedRange As Range
    
    Set oCopiedRange = ActiveWindow.VisibleRange '<== change this range as required.
    With Me.Frame1
        .ScrollBars = fmScrollBarsBoth
        .ScrollWidth = oCopiedRange.Width
        .ScrollHeight = oCopiedRange.Height
        .PictureAlignment = fmPictureAlignmentCenter
        Set .Picture = CreateRangePic(oCopiedRange)
    End With

End Sub

  
Private Function CreateRangePic(ByVal Rng As Range) As IPictureDisp
         
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    
    On Error GoTo errHandler
    
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPtr
        .hPal = 0
    End With
    OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
    Set CreateRangePic = IPic
errHandler:
    CloseClipboard
End Function


تم تحرير المشاركة بواسطة :جعفر الطريبق
بتاريخ:15-09-2017 05:39 مساء


أثارت هذه المشاركة إعجاب: Salamco، حسين مامون، الصقر، Yasser Elaraby،




15-09-2017 06:32 مساء
مشاهدة مشاركة منفردة [6]
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
استاذ جعفر يعجر اللسان عن وصفك
جزاك الله خيرا وتحملني اذا كثرت عليك الاسئله

استاذي العزيز نجح الكود ولله الحمد 

هل يوجد كود لجعل حجم النماذج يتلائم مه حجم اي شاشة بحيث لايؤثر على ترتيب وشكل الادوات على النموذج 000
مع التقدير والاحترام

أثارت هذه المشاركة إعجاب: الصقر،




15-09-2017 09:34 مساء
مشاهدة مشاركة منفردة [7]
جعفر الطريبق
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 14-09-2017
رقم العضوية : 477
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 19-4-1968
يتابعهم : 0
يتابعونه : 6
قوة السمعة : 95
الاعجاب : 30
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
المشاركة الأصلية كتبت بواسطة: Salamco »
استاذ جعفر يعجر اللسان عن وصفك
جزاك الله خيرا وتحملني اذا كثرت عليك الاسئله

استاذي العزيز نجح الكود ولله الحمد 

هل يوجد كود لجعل حجم النماذج يتلائم مه حجم اي شاشة بحيث لايؤثر على ترتيب وشكل الادوات على النموذج 000
مع التقدير والاحترام


السللم عليكم 

اعذرني لكنني لم أفهم ... لست متعودا على مصطلحات الاكسيل  بالعربية 
ما المقصود بالنماذج و الادوات على النموذج  .. ممكن تترجم بالانجليزي أو الفرنسي


تم تحرير المشاركة بواسطة :جعفر الطريبق
بتاريخ:15-09-2017 09:34 مساء


أثارت هذه المشاركة إعجاب: Salamco،




16-09-2017 12:38 مساء
مشاهدة مشاركة منفردة [8]
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
الادوات tools 
النماذج forms
شكرا استاذ





16-09-2017 02:29 مساء
مشاهدة مشاركة منفردة [9]
جعفر الطريبق
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 14-09-2017
رقم العضوية : 477
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 19-4-1968
يتابعهم : 0
يتابعونه : 6
قوة السمعة : 95
الاعجاب : 30
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
السلام عليكم

هل تقصد انك تريد الفورم أن يملأ الشاشة كلها 





16-09-2017 05:55 مساء
مشاهدة مشاركة منفردة [10]
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
نعم استاذ جعفر
ويتغير حجمه مع تغير حجم شاشة الحاسبه 
اي عند تشغيله على اي حاسبه اخرى يكون حجمه يملئ هذه الحاسبه
وشكرا لجهودك الجباره 
ارجو ان اكون واضحا





16-09-2017 06:03 مساء
مشاهدة مشاركة منفردة [11]
جعفر الطريبق
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 14-09-2017
رقم العضوية : 477
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 19-4-1968
يتابعهم : 0
يتابعونه : 6
قوة السمعة : 95
الاعجاب : 30
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
السلام عليكم

طيب - هل تريد هذه الخاصية واظهار الشيت على الفورم في نفس الوقت كما في السابق

سأحاول كتابة كود يجمع كلتا الخاصيتين - أرجو ان أوفق في ذالك -  لكن اعطيني بعض الوقت لانني مشغول حاليا 


تم تحرير المشاركة بواسطة :جعفر الطريبق
بتاريخ:16-09-2017 06:03 مساء






16-09-2017 06:11 مساء
مشاهدة مشاركة منفردة [12]
Salamco
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 216
المشاركات : 220
الجنس : ذكر
تاريخ الميلاد : 6-6-1980
يتابعهم : 7
يتابعونه : 2
قوة السمعة : 65
الاعجاب : 24
 offline 
look/images/icons/i1.gif عمل جزء من اليوزر فورم لاظهار شيت الاكسل الذي اعمل عليه حاليا
شكرا استاذ جعفر الرائع
لا ليس بالضروره بل اريده على حده
وشكرا






المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
دورة اليوزرفورم الجزء الاول مقدمة عن اليوزرفورم Userform emad ghazi
7 735 YasserKhalil
مساعدة في التعديل من خلال اليوزر فورم محمد سويد
9 165 محمد سويد
كيفية اظهار التقويم فى اليوزرفورمDate and Time Picker وحل مشكلة اظهارAddtional contorol emad ghazi
10 790 عبدالله الصاري
هل من الممكن حساب الوارد+المرتجع - الصادر داخل اليوزر فورم محمدحسني احمد
19 323 محمدحسني احمد
ترحيل درجات الطلبة حسب الفصول باليوزر فورم malik
1 147 malik

الكلمات الدلالية
اليوزر ، فورم ، لاظهار ، الاكسل ، الذي ، اعمل ، عليه ، حاليا ،


 







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



الساعة الآن 03:45 مساء

أعلن هنا
أعلن هنا
أعلن هنا