Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

2 Ocak 2013 Çarşamba

Data Transfer From MS Project to MS Excel.

 
'Module1
  Option Explicit
  Private MPF 'Project Files
  Private MPA As MSProject.Application 'Microsoft Project Application
  Private MPT As Task 'Microsoft Project Tasks
  Private MEC As Range 'Microsoft Excel Cells
  'A) Adding Reference
  '    Reference Name:= MicrosoftProject 14.0 Object Library
  '    Reference URL:= C:\Program Files (x86)\Microsoft Office\Office14\MSPRJ.OLB
  'B) Example (mpp) File
  '    File URL:= http://office.microsoft.com/en-us/templates/project-office-plan-TC001018451.aspx?pid=CT102530621033
  '    File URL:= http://office.microsoft.com/en-us/templates/fundraiser-event-plan-TC010275175.aspx?pid=CT101172751033
  Sub Project_To_Excel() 'Data transfer from MS Project to MS Excel.
      On Error Resume Next
          MPF = Application.GetOpenFilename("Microsoft Project Files (*.mpp), *.mpp")
          If MPF = False Then
              Exit Sub
          End If
          Sheets(1).Visible = True
          Sheets(1).Select
          Cells.Select
          Selection.Delete Shift:=xlUp
          Range(Range("A18:J18"), Range("A18:Z18").End(xlDown)).Clear
          Call Page_Format
          Set MPA = New MSProject.Application
          MPA.Visible = False 'True
          If MPA.Visible = True Then AppActivate "Microsoft Project"
          MPA.FileOpen MPF
          Set MEC = Range("A18")
          For Each MPT In MPA.ActiveProject.Tasks
              If Not MPT Is Nothing Then
                  MEC.Offset(0, 0).Value = MPT.UniqueID
                  MEC.Offset(0, 1).Value = MPT.Name
                  MEC.Offset(0, 2).Value = MPT.DurationText
                  MEC.Offset(0, 3).Value = MPT.EarlyStart
                  MEC.Offset(0, 4).Value = MPT.EarlyFinish
                  MEC.Offset(0, 5).Value = MPT.LateStart
                  MEC.Offset(0, 6).Value = MPT.LateFinish
                  MEC.Offset(0, 7).Value = MPT.Predecessors
                  MEC.Offset(0, 8).Value = MPT.WBS
                  MEC.Offset(0, 9).Value = MPT.OutlineLevel - 1
                  Set MEC = MEC.Offset(1, 0)
              End If
          Next MPT
          [F2] = MPA.ActiveProject.DetectCycle.Count
          [F3] = MPA.ActiveProject.FullName
          [F4] = MPA.ActiveProject.HoursPerWeek
          [F5] = MPA.ActiveProject.DaysPerMonth
          [F6] = MPA.ActiveProject.HoursPerDay
          [F7] = MPA.ActiveProject.ID
          [F8] = MPA.ActiveProject.Index
          [F9] = MPA.ActiveProject.ProjectFinish
          [F10] = MPA.ActiveProject.ProjectStart
          [F11] = MPA.ActiveProject.Tasks.Count
          [F12] = MPA.ActiveProject.TaskTables.Count
          [F13] = MPA.ActiveProject.TaskTables(1).TableFields.Count
          [F14] = MPA.ActiveProject.TaskTables(1).TableFields(1).Field
          [F15] = MPA.ActiveProject.WBSVerifyUniqueness
      MPA.FileClose pjDoNotSave
      MPA.Quit
      Set MPA = Nothing
      AppActivate "Microsoft Excel"
      Range("A1").Select
  End Sub
  Private Sub Page_Format()
      On Error Resume Next
      Range("B2").FormulaR1C1 = "ActiveProject.DetectCycle.Count"
      Range("B3").FormulaR1C1 = "ActiveProject.FullName"
      Range("B4").FormulaR1C1 = "ActiveProject.HoursPerWeek"
      Range("B5").FormulaR1C1 = "ActiveProject.DaysPerMonth"
      Range("B6").FormulaR1C1 = "ActiveProject.HoursPerDay"
      Range("B7").FormulaR1C1 = "ActiveProject.ID"
      Range("B8").FormulaR1C1 = "ActiveProject.Index"
      Range("B9").FormulaR1C1 = "ActiveProject.ProjectFinish"
      Range("B10").FormulaR1C1 = "ActiveProject.ProjectStart"
      Range("B11").FormulaR1C1 = "ActiveProject.Tasks.Count"
      Range("B12").FormulaR1C1 = "ActiveProject.TaskTables.Count"
      Range("B13").FormulaR1C1 = "ActiveProject.TaskTables(1).TableFields.Count"
      Range("B14").FormulaR1C1 = "ActiveProject.TaskTables(1).TableFields(1).Field"
      Range("B15").FormulaR1C1 = "ActiveProject.WBSVerifyUniqueness"
      With Range("B2:E15")
          .HorizontalAlignment = xlLeft
          .VerticalAlignment = xlCenter
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
          With .Font
              .Name = "Calibri"
              .FontStyle = "Regular"
              .Size = 11
              .Strikethrough = False
              .Superscript = False
              .Subscript = False
              .OutlineFont = False
              .Shadow = False
              .Underline = xlUnderlineStyleNone
              .ThemeColor = xlThemeColorDark1
              .TintAndShade = 0
              .ThemeFont = xlThemeFontMinor
          End With
          With .Interior
              .Pattern = xlSolid
              .PatternColorIndex = xlAutomatic
              .Color = 6299648
              .TintAndShade = 0
              .PatternTintAndShade = 0
          End With
      End With
      Range("A17").FormulaR1C1 = "UniqueID"
      Range("B17").FormulaR1C1 = "Name"
      Range("C17").FormulaR1C1 = "DurationText"
      Range("D17").FormulaR1C1 = "EarlyStart"
      Range("E17").FormulaR1C1 = "EarlyFinish"
      Range("F17").FormulaR1C1 = "LateStart"
      Range("G17").FormulaR1C1 = "LateFinish"
      Range("H17").FormulaR1C1 = "Predecessors"
      Range("I17").FormulaR1C1 = "WBS"
      Range("J17").FormulaR1C1 = "OutlineLevel - 1"
      Range("A17").ColumnWidth = 6
      Range("B17:J17").ColumnWidth = 12
      Range("D17:G17").ColumnWidth = 16
      With Range("A17:J17")
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .WrapText = True
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = True
          .ReadingOrder = xlContext
          .MergeCells = False
          With .Font
              .Name = "Calibri"
              .FontStyle = "Regular"
              .Size = 11
              .Strikethrough = False
              .Superscript = False
              .Subscript = False
              .OutlineFont = False
              .Shadow = False
              .Underline = xlUnderlineStyleNone
              .ThemeColor = xlThemeColorDark1
              .TintAndShade = 0
              .ThemeFont = xlThemeFontMinor
          End With
          With .Interior
              .Pattern = xlSolid
              .PatternColorIndex = xlAutomatic
              .Color = 6299648
              .TintAndShade = 0
              .PatternTintAndShade = 0
          End With
      End With
      Range("I:I").NumberFormat = "@"
  End Sub
 
 

 

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul