VBA

  • 계산과 Screenupdating 안하기

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)")

  • for i 보다 for each
  • 자동채우기

Range("G2:O2").AutoFill Destination:=Range("G2:O" & Range("A" & Rows.Count).End(xlUp).Row)

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

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

<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>

  • 리본메뉴 Dynamically 수정하기

'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

  • for i =1to10

Set Wf = WorksheetFunction
With Wf
  .함수들..
end with

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

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

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

파일 열기


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)

TextBox 추가

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"

Bullet 추가

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

Dropbox

  • 목록 수정

With ActiveSheet.Shapes("이름").ControlFormat
  .ListFillRange = "범위"
  .LinkedCell = "셀"
  .DropDownLines = 개수
End With

Enter your comment:
H A Q᠎ J X