본문 바로가기
다양한 실전소스코드/EXCEL, ACCESS

[Solved] 엑셀 그림 밝게 처리_엑셀 이미지 내보내기

by aibattle 2021. 5. 14.
728x90
반응형

요즘같은 시대에 어울리지 않을수도 있지만

이미지 파일이 100개 쯤 있는데, 엑셀로 그 이미지를 한번에 밝게 할수 있는 방법입니다.

(단, 화질이 좀 저하됨)

vba를 할줄 알아야 이해가 될수 있으니 주의 바랍니다.

이미지를 시트로 불러와서 밝게 처리하고나서 차트로 변경한뒤 다시 내보내는 과정입니다.

Application.ScreenUpdating = 0

Dim chtChart As ChartObject

Dim strFile As String

Dim strType As String

Dim strDupe As String

Dim strTemp As String

Dim rngTarget As Range

Dim b, p, r As Integer

Dim k, AP As String

Dim a As Integer

Dim sht As Variant

Dim pic As Object

Set sht = ActiveSheet

Sheets("목록").Select '여기에 파일의 목록이 있어야한다. (목록얻는건 다른데 찾아보면 많다.)

r = Range(Cells(1, 1), Cells(60000, 1).End(xlUp)).Rows.Count

b = 1

For a = 2 To r

strFile = "d:\까치\" & Sheets("목록").Cells(a, 1).Value '파일목록을 저장했다가

b = b + 1

 

Sheets("그림").Select

sht.Pictures.Insert(strFile).Select '엑셀 시트에다 그림을 추가한다.

With Selection

.Top = Cells(1, 1).Top

.Left = Cells(1, 1).Left

.Width = Columns(1).Width

.Height = Rows(1).Height

.OnAction = "ImportPictureFile"

 

.ShapeRange.PictureFormat.ColorType = msoPictureGrayscale

.ShapeRange.PictureFormat.Brightness = 0.7 '밝기 처리를 해주고나서

.ShapeRange.PictureFormat.Contrast = 0.7

Range(.TopLeftCell.Address).Select

End With

 

 

 

 

Set rngTarget = Sheets("그림").Range(Cells(1, 1), Cells(1, 1))

strFile = "e:\작은이미지\밝게\" & "변경파일-" & b & ".gif"

Worksheets.Add

strTemp = ActiveSheet.Name

Charts.Add

ActiveChart.Location where:=xlLocationAsObject, Name:=strTemp

Set chtChart = Worksheets(strTemp).ChartObjects(1)

rngTarget.CopyPicture appearance:=xlScreen, Format:=xlPicture

With chtChart

.Border.LineStyle = xlLineStyleNone

.Width = rngTarget.Width

.Height = rngTarget.Height

.Chart.Paste

.ShapeRange.IncrementLeft 3.75

.Chart.Export Filename:=strFile, filtername:="gif" '파일을 저장한다.

End With

Exit Sub

Application.DisplayAlerts = False

Worksheets(strTemp).Delete

Application.DisplayAlerts = False

Next a

End Sub

728x90
반응형

댓글