요즘같은 시대에 어울리지 않을수도 있지만
이미지 파일이 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
'다양한 실전소스코드 > EXCEL, ACCESS' 카테고리의 다른 글
[Solved] Excel VBA Special Charactor Include Check (엑셀 특정문자 포함여부 체크) (0) | 2021.07.06 |
---|---|
[Solved] ms access db 연동 + app crash 해결 (0) | 2021.05.14 |
댓글