'이미지 파일을 읽어와서 쉘에 붙여 넣는것
Public Sub GetPic()
Dim aWB As Excel.Workbook
Dim aSht As Excel.Worksheet
Dim aRng As Excel.Range
Dim rngA As Excel.Range
Dim rng8 As Excel.Range
Dim aShp As Excel.Shape
Dim isImgExist As String
Dim bmpName As String
Dim pathName As String
Dim nSize As Integer
On Error GoTo hErr:
Set aSht = ActiveSheet
' Set rngA = aSht.Range("기준열")
Set rngA = aSht.Range("B4")
Set rngA = aSht.Range(rngA, rngA.End(xlDown))
' pathName = "경로"
pathName = "d:\민용헌\GEN3\SYMBOL_130821\LOGO\"
' nSize = 이미지 사이즈(pixel단위)
nSize = 32
For Each aRng In rngA
' Set rng8 = aRng.Offset(기준열로부터의 오프셋)
Set rng8 = aRng.Offset(0, 5)
imgname = aRng.Value
' imgname = imgname & ".이미지 확장자"
imgname = imgname & ".png"
isImgExist = Dir(pathName & imgname)
If (isImgExist <> "") Then
aSht.Pictures.Insert(pathName & imgname).Select
Selection.ShapeRange.Left = (rng8.Width - nSize) / 2 + rng8.Left
Selection.ShapeRange.Top = (rng8.Height - nSize) / 2 + rng8.Top
Selection.ShapeRange.PictureFormat.TransparentBackground = True
Selection.ShapeRange.PictureFormat.TransparencyColor = RGB(255, 0, 255)
End If
Next
MsgBox "Complete"
Exit Sub
hErr:
' 예외처리
Resume
End Sub
'통계내는것
Option Explicit
Public Sub 중분류_요약()
Dim shtOne As Excel.Worksheet
Dim shtTwo As Excel.Worksheet
Dim rngOne As Excel.Range
Dim rngTwo As Excel.Range
Dim rngAll As Excel.Range
Dim rngEnd As Excel.Range
Dim rngDat As Excel.Range
Dim rngSun As Excel.Range
Dim strName As String
Dim strSheet As String
Dim strFomula As String
Dim n As String
Dim b As String
Dim e As String
On Error GoTo hErr
Set shtOne = ActiveWorkbook.Worksheets("명칭")
Set shtTwo = ActiveWorkbook.Worksheets("명칭_중분류")
shtTwo.Range("D3").Value = Format(Now, "yyyy-mm-dd")
Set rngOne = shtOne.Range("B5")
Set rngTwo = shtTwo.Range("C10")
Set rngEnd = rngOne.End(xlDown)
Set rngAll = shtOne.Range(rngOne, rngOne.End(xlDown))
rngOne = Application.ConvertFormula(rngOne.Formula, xlA1, xlA1, xlRelative)
strSheet = "명칭"
For Each rngOne In rngAll
DoEvents
If strName = "" Then
strName = rngOne.Text
Set rngSun = rngOne
End If
If rngOne.Text <> strName Then
shtTwo.Activate
n = rngTwo.Row
b = rngSun.Row
e = rngOne.Offset(-1, 0).Row
' 건수 OLD
strFomula = FormatString("=SUM($s!G$s:G$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 3)
rngDat.Formula = strFomula
' 건수 NEW
strFomula = FormatString("=SUM($s!H$s:H$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 4)
rngDat.Formula = strFomula
strName = rngOne.Text
Set rngTwo = rngTwo.Offset(1, 0)
Set rngSun = rngOne.Offset(0, 0)
End If
If rngOne.Address = rngEnd.Address Then
shtTwo.Activate
n = rngTwo.Row
b = rngSun.Row
e = rngOne.Offset(-1, 0).Row
strFomula = FormatString("=SUM($s!G$s:G$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 3)
rngDat.Formula = strFomula
' 건수 NEW
strFomula = FormatString("=SUM($s!H$s:H$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 4)
rngDat.Formula = strFomula
End If
Next
Exit Sub
hErr:
MsgBox "중분류 요약 에러" & Err.Description
End Sub
Public Sub 대분류_요약()
Dim shtOne As Excel.Worksheet
Dim shtTwo As Excel.Worksheet
Dim rngOne As Excel.Range
Dim rngTwo As Excel.Range
Dim rngDat As Excel.Range
Dim rngAll As Excel.Range
Dim rngEnd As Excel.Range
Dim rngSun As Excel.Range
Dim strName As String
Dim strSheet As String
Dim strFomula As String
Dim n As String
Dim b As String
Dim e As String
On Error GoTo hErr
Set shtOne = ActiveWorkbook.Worksheets("명칭_중분류")
Set shtTwo = ActiveWorkbook.Worksheets("명칭_대분류")
shtTwo.Range("D3").Value = Format(Now, "yyyy-mm-dd")
Set rngOne = shtOne.Range("B10")
Set rngTwo = shtTwo.Range("B10")
Set rngEnd = rngOne.End(xlDown)
Set rngAll = shtOne.Range(rngOne, rngOne.End(xlDown))
rngOne = Application.ConvertFormula(rngOne.Formula, xlA1, xlA1, xlRelative)
strSheet = "명칭_중분류"
For Each rngOne In rngAll
DoEvents
If strName = "" Then
strName = rngOne.Text
Set rngSun = rngOne
End If
If rngOne.Text <> strName Then
shtTwo.Activate
n = rngTwo.Row
b = rngSun.Row
e = rngOne.Offset(-1, 0).Row
' 건수 OLD
strFomula = FormatString("=SUM($s!F$s:F$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 4)
rngDat.Formula = strFomula
' 건수 NEW
strFomula = FormatString("=SUM($s!G$s:G$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 5)
rngDat.Formula = strFomula
strName = rngOne.Text
Set rngTwo = rngTwo.Offset(1, 0)
Set rngSun = rngOne.Offset(0, 0)
End If
If rngOne.Address = rngEnd.Address Then
shtTwo.Activate
n = rngTwo.Row
b = rngSun.Row
e = rngOne.Offset(-1, 0).Row
' 건수 OLD
strFomula = FormatString("=SUM($s!F$s:F$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 4)
rngDat.Formula = strFomula
' 건수 NEW
strFomula = FormatString("=SUM($s!G$s:G$s)", strSheet, b, e)
strFomula = Replace(strFomula, "'", """")
Set rngDat = rngTwo.Offset(0, 5)
rngDat.Formula = strFomula
End If
Next
Exit Sub
hErr:
MsgBox "대분류 요약 에러" & Err.Description
End Sub
Public Function FormatString(ByVal src As String, ParamArray mRepStr())
' #VBIDEUtils#************************************************************
' *
' * Procedure Name : printf
' * Parameters :
' * ByVal src As String
' * ParamArray mRepStr()
' * *******************************************************************
' * Comments : $VBCR -> vbcrlf 으로 대체
' * $VBTAB -> vbTabl으로 대체
' *
' * *******************************************************************
Dim s As Variant
src = Replace(src, "$VBCR", vbCrLf)
src = Replace(src, "$VBTAB", vbTab)
For Each s In mRepStr
src = Replace(src, "$s", s, , 1, vbTextCompare)
Next
FormatString = src
End Function