مساعده حفظ نطاق معين SCREENSHOT

[ahmed01111]

اريد كود  لأخذ اسكرين شوت معين فى ورقة العمل وحفظه فى فولدر خارجى

شكرا مقدما ......

[محمد يوسف ابو يوسف]

السلام عليكم ..هذا حل مني..يتم حفظ صورة بي دي اف ---- علي برتيشن d

Sub طباعه_عامة()
                         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "d:\" & Format(Now, "- dd-mm-yyyy-") & Nombre & " " & QualityxlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Application.ScreenUpdating = True
End Sub

 

[ahmed01111]

تفضل

العبقرى.xlsm

[محمد يوسف ابو يوسف]

تفضل  العبقرى.xlsm

[ahmed01111]

جزاك الله خير 

نجحت الف شكر كان عندى مشكله فى أسم البارتيشن الف شكر

ولكن هل ممكن تبقى صوره هو كده ممتاز ويأدى الغرض ولكن طمع فى كرمك 😂

[حسين مامون]

بعد اذن الاخوة هذا الشيء ينسخ المدى المحدد ويحوله الى pdf  

حدد المدى الذي تريد وفعل الماكرو

Option Explicit

Sub rngSelect()
Dim R
Dim fil_name
fil_name = ThisWorkbook.Path & "\" & fil_name & Format(Now(), "dd-mm-yyyy-  hh.mm.ss")
 R = (Selection.Address)
Range(R).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fil_name
MsgBox "النسخة تجدها في نفس مكان الملف الاصلي", vbInformation
End Sub

 

[ahmed01111]

هل ممكن ان يتم الحفظ على الديسك توب

[omar elhosseini]

اخي شاهد المرفق

حدد المدي الذي تريد تصويرة

ثم اضغط الزر

ستجد الصورة علي الديسك توب

Rng_To_Jpeg_1.xlsm

[AliBadawy]

Dim ss As Long
    Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "Capture2.jpg"
   'لو عايز تغيير مكان الحفظ تقدر تغييره مكان كلمة desktop ولو عايز تغيير الاسم تقدر تغيير capture2
   
   ss = Cells(235, 7).End(xlUp).Row ' ss دي عملتها عشان اخر سطر فيه بيانات
   'celles(235,7) انا هنا حددت اخر سطر هيبحث من عنده لفوق و اخترت 7 عشان ياخد من اخر سطر في بينات العموم رقم 7
    Set Rng = Sheets("اسم صفحة العمل").Range("e171:g" & ss) 'e171:g ده النطاق اللي عايز يتاخد ليه سكرين شوت 
' اما باقي الكود مش فاكر والله كنت جايبه منين تقريبا من موقع اجنبي
    Call Rng.CopyPicture(xlScreen, xlPicture)
    With Sheets.Add
        .Shapes.AddChart
        .Activate
        .Shapes.Item(1).Select
        Set aChart = ActiveChart
        .Shapes.Item(1).Line.Visible = msoFalse
        .Shapes.Item(1).Width = Rng.Width
        .Shapes.Item(1).Height = Rng.Height
        aChart.Paste
        aChart.Export (Path)
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved to " & vbCr & Path, vbInformation, ""