سلام یک فایل اکسل دارم که در یکی از شیتها چندتا عکس دارم چطور می تونم با ماکرو یک خروجی با نمایش نه پرینت از عکسها داشته باشم و هر عکسی در یک صفحه باشه؟ ممنون
-
-
با سلام در فایل زیر با انتخاب یک محدوده می توان خروجی به صورت عکس دریافت کرد حالا چطور میشه تغییرات زیر را توی ماکرو بدیم :
نمی خواهیم محدوده ای انتخاب کنیم به جای محدوده ، عکسی که در شیت هست انتخاب بشه و به صورت عکس دریافت بشه همین///
ممنون
-
سلام،
بررسی کنید
تصویر در مسیر دسکتاپ و داخل پوشه test ذخیره می شودکد:Sub M_ExceL() Dim shp As Shape sPath = Environ("USERPROFILE") & "\Desktop\test" Folder = Dir(sPath, vbDirectory) If Folder = vbNullString Then MkDir (sPath) End If strImageName = "test" Set shp = ActiveSheet.Shapes("Picture 1") shp.Select Selection.ShapeRange.PictureFormat.Contrast = 0.5 Selection.ShapeRange.PictureFormat.Brightness = 0.5 Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Line.Visible = msoFalse Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.PictureFormat.CropLeft = 0# Selection.ShapeRange.PictureFormat.CropRight = 0# Selection.ShapeRange.PictureFormat.CropTop = 0# Selection.ShapeRange.PictureFormat.CropBottom = 0# Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft Application.Selection.CopyPicture Set oDia = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) Set oChartArea = oDia.Chart oDia.Activate With oChartArea .ChartArea.Select .Paste .Export (sPath & "\" & strImageName & ".jpg") End With oDia.Delete End Sub[CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
[/CENTER]کامنت
-
سلام ممنون عالیه فقط یک سوال چطور میشه محل ذخیره خروجی داده شده که در دستکتاپ هست به جای ان محلی باشه که فایل اصلی قرار داره؟
باز هم ممنون از پاسخ سریعتان
سپاسکامنت
-
سلام ممنون میشه بگین کجای کد اصلی قرار بدم؟کامنت
-
سلام،
کد:Sub M_ExceL() Dim shp As Shape sPath = ActiveWorkbook.Path strImageName = "test" Set shp = ActiveSheet.Shapes("Picture 1") shp.Select Selection.ShapeRange.PictureFormat.Contrast = 0.5 Selection.ShapeRange.PictureFormat.Brightness = 0.5 Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Line.Visible = msoFalse Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.PictureFormat.CropLeft = 0# Selection.ShapeRange.PictureFormat.CropRight = 0# Selection.ShapeRange.PictureFormat.CropTop = 0# Selection.ShapeRange.PictureFormat.CropBottom = 0# Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft Application.Selection.CopyPicture Set oDia = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) Set oChartArea = oDia.Chart oDia.Activate With oChartArea .ChartArea.Select .Paste .Export (sPath & "\" & strImageName & ".jpg") End With oDia.Delete End Sub[CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
[/CENTER]کامنت
-
ممنون وسپاس مشکل حل شدکامنت
کامنت