====== VBA ======

{{tag>VBA 개발 Excel}}

[[data_analysis:excel|Excel]]

[[blog:excel_vba_ribbon_menu|]]

[[blog:excel_syntax_highlighting_sql|]]


===== Performance of VBA =====

  * 계산과 Screenupdating 안하기

<code vb>
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

열려 있는 모든 통합 문서   Application.Calculate (또는 Calculate)
특정 워크시트        Worksheets(1).Calculate
특정 범위        Worksheets(1).Rows(2).Calculate
Worksheets(""Sheet1"").UsedRange.Columns(""A:C"").Calculate

range("A1").FormulaR1C1 = "=TODAY()"
Range("F2") = Evaluate("SUM((B2:B60001=E2)*C2:C60001)")
</code>

  * for i 보다 for each
  * **자동채우기**
<code vb>
Range("G2:O2").AutoFill Destination:=Range("G2:O" & Range("A" & Rows.Count).End(xlUp).Row)
</code>


===== 리본메뉴만들기 =====

[[http://openxmldeveloper.org/blog/b/openxmldeveloper/archive/2006/05/25/customuieditor.aspx|http://openxmldeveloper.org/blog/b/openxmldeveloper/archive/2006/05/25/customuieditor.aspx]]

  * 'Home' 탭에 리본메뉴 추가

<code xml>
<tab idMso="TabHome">
   <group id="customGroup"  insertAfterMso="GroupStyles" label="Remove Styles">
       <button id="customButton"  getLabel="GetButtonLabel" size="large" imageMso="CellStylesGallery"
         onAction="RemoveTheStyles" screentip="Remove Styles"
         supertip="Removes all but the default set of styles, any styles in use other than those will revert to using the Normal style."/>
   </group>
</tab>
</code>
  * 리본메뉴 Dynamically 수정하기

<code vb>
'Callback for customButton getLabel
Sub GetButtonLabel(control As IRibbonControl, ByRef returnedVal)
  If ActiveWorkbook Is Nothing Then
      returnedVal = "Remove Styles"
  Else
      returnedVal = "Remove Styles" & vbCr & Format(ActiveWorkbook.Styles.Count, "#" & Application.International(xlThousandsSeparator) & "##0")
  End If
End Sub
</code>


=====   progress bar   =====

===== 헷갈리는/자주쓰는 문법 =====

  * for i =1to10
  *

<code vb>
Set Wf = WorksheetFunction
With Wf
  .함수들..
end with

</code>

  * Error 처리 [[https://m.blog.naver.com/PostView.nhn?blogId=smilo73&logNo=220304995739&proxyReferer=https://www.google.co.kr/|https://m.blog.naver.com/PostView.nhn?blogId=smilo73&logNo=220304995739&proxyReferer=https%3A%2F%2Fwww.google.co.kr%2F]]
  * Create Sheet  [[https://stackoverflow.com/questions/20697706/how-to-add-a-named-sheet-at-the-end-of-all-excel-sheets|https://stackoverflow.com/questions/20697706/how-to-add-a-named-sheet-at-the-end-of-all-excel-sheets]]
      *

<code vb>
 Private Sub CreateSheet()
   Dim ws As Worksheet
   With ThisWorkbook
       Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
       ws.Name = "Tempo"
   End With
 End Sub
</code>

  * Does Sheet Exist?  [[https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists|https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists]]
      *

<code vb>
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
  Dim sht As Worksheet
  If wb Is Nothing Then Set wb = ThisWorkbook
  On Error Resume Next
  Set sht = wb.Sheets(shtName)
  On Error GoTo 0
  WorksheetExists = Not sht Is Nothing
End Function
</code>

  * Array Function 사용법 https://www.get-digital-help.com/how-to-use-the-array-function-vba/

  * Optional Parameter ''Sub name(ByVal parameter1 As datatype1, Optional ByVal parameter2 As datatype2 = defaultvalue)''
  


===== Powerpoint 제어 =====
==== 파일 열기 ====
<code vb>

Dim DestinationPPT as string
Dim PowerPointApp as Object
Dim myPresentation as Object
Dim mySlide as Object

Set PowerPointApp = CreateObject("PowerPoint.Application")

DestinationPPT = "c:\...."
Set myPresentation = PowerpointApp.Presentations.Open(DestinationPPT)

</code>

==== TextBox 추가 ====
<code vb>
Set mySlide = myPresentation.Slides(1)

Set tBox = mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, left:=30, top=30, Width:=20, Height:=20)
tBox.TextFrame.TextRange.Text = "Text"
</code>

==== Bullet 추가 ====
<code vb>
With tBox.TextFrame.TextRange.ParagraphFormat.Bullet
  .Type = ppBulletUnnumbered
  .Font.Name = "Wingdings"
  .Character = bullet_-chr '252:checkmark, 113: Box,  167:filled square black
End With
</code>

===== Control 제어 =====

=== Dropbox ===
  * 목록 수정
<code vb>
With ActiveSheet.Shapes("이름").ControlFormat
  .ListFillRange = "범위"
  .LinkedCell = "셀"
  .DropDownLines = 개수
End With
</code>

===== 기타 =====

https://stackoverflow.com/questions/1026483/is-there-a-way-to-crack-the-password-on-an-excel-vba-project

~~DISCUSSION~~