396 lines
13 KiB
QBasic
396 lines
13 KiB
QBasic
Option Explicit
|
|
|
|
Dim ppt As PowerPoint.Application
|
|
Dim pres As PowerPoint.Presentation
|
|
|
|
Dim sl As PowerPoint.Slide
|
|
Dim cl As PowerPoint.CustomLayout
|
|
Dim sh As PowerPoint.ShapeRange
|
|
|
|
Dim pres_right As Integer
|
|
Dim pres_left As Integer
|
|
Dim pres_title_top As Integer
|
|
Dim pres_body_top As Integer
|
|
|
|
Dim cell_this_month_income As String
|
|
Dim rngETA As Range
|
|
Dim rngActive As Range
|
|
|
|
Dim textCellList(5) As String
|
|
|
|
Dim alphabatList(6) As String
|
|
Dim numberList(17 - 8) As String
|
|
|
|
|
|
Sub ReplaceInPowerPoint(text_look_for As String, text_replace As String, look_into_slide As Integer)
|
|
' MsgBox text_look_for,,"title"
|
|
' MsgBox text_replace,,"title"
|
|
' MsgBox look_into_slide,,"title"
|
|
Debug.Print ppt
|
|
|
|
Dim oSld As Slide
|
|
Set oSld = ppt.ActivePresentation.Slides(look_into_slide)
|
|
|
|
|
|
Dim shp As PowerPoint.Shape
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim temp As String
|
|
' Dim text_look_for, text_replace As String
|
|
Dim exitLoop As Boolean
|
|
|
|
exitLoop = False
|
|
For Each shp In oSld.Shapes
|
|
If shp.HasTable Then
|
|
For i = 1 To shp.Table.Rows.Count
|
|
For j = 1 To shp.Table.Columns.Count
|
|
temp = shp.Table.Rows.item(i).Cells(j).Shape.TextFrame.TextRange.Text
|
|
If (InStr(1, temp, text_look_for) > 0) Then
|
|
shp.Table.Rows.item(i).Cells(j).Shape.TextFrame.TextRange.Text = _
|
|
Replace(temp, text_look_for, text_replace)
|
|
exitLoop = True
|
|
|
|
If (exitLoop) Then
|
|
Debug.Print "exit j"
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next j
|
|
|
|
If (exitLoop) Then
|
|
Debug.Print "exit i"
|
|
Exit For
|
|
End If
|
|
Next i
|
|
End If
|
|
|
|
If (exitLoop) Then
|
|
Debug.Print "exit shp"
|
|
Exit For
|
|
End If
|
|
Next shp
|
|
|
|
|
|
End Sub
|
|
|
|
Sub updateStatus(msg As String)
|
|
Range("A1:A1").Value = msg
|
|
End Sub
|
|
|
|
Sub replaceInSlide0(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
Dim activeSheet As Integer
|
|
activeSheet = 1
|
|
|
|
|
|
updateStatus "replaceInSlide0"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide0" & textCell & ":" & textCell
|
|
|
|
If (Chr(i) = "F" Or j = 16) Then
|
|
' intented empty
|
|
Else
|
|
If (Chr(i) = "E" Or Chr(i) = "I") Then
|
|
If (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Else
|
|
If (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "(" & Abs(rngActive.Value) & ")", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, rngActive.Value, activeSheet
|
|
End If
|
|
End If
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
Sub replaceInSlide1(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
|
|
Dim activeSheet As Integer
|
|
activeSheet = 2
|
|
|
|
updateStatus "replaceInSlide1"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide1" & textCell & ":" & textCell
|
|
|
|
If (Chr(i) = "E" Or Chr(i) = "I") Then
|
|
If (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Else
|
|
If (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "(" & Abs(rngActive.Value) & ")", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, rngActive.Value, activeSheet
|
|
End If
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
Sub replaceInSlide2(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
Dim activeSheet As Integer
|
|
activeSheet = 3
|
|
|
|
updateStatus "replaceInSlide2"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide2" & textCell & ":" & textCell
|
|
If (Chr(i) = "D") Then
|
|
If (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Else
|
|
If (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "(" & Abs(rngActive.Value) & ")", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, rngActive.Value, activeSheet
|
|
End If
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
Sub replaceInSlide3(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
Dim activeSheet As Integer
|
|
activeSheet = 4
|
|
|
|
updateStatus "replaceInSlide3"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide3" & textCell & ":" & textCell
|
|
If (Chr(i) = "D") Then
|
|
If (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Else
|
|
If (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "(" & Abs(rngActive.Value) & ")", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, rngActive.Value, activeSheet
|
|
End If
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
|
|
Sub replaceInSlide4(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
Dim activeSheet As Integer
|
|
activeSheet = 5
|
|
|
|
updateStatus "replaceInSlide4"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide4" & textCell & ":" & textCell
|
|
|
|
Debug.Print textCell & "||Value||" & rngActive.Value
|
|
Debug.Print textCell & "||text||" & rngActive.Text
|
|
|
|
If (Chr(i) = "D") Then
|
|
If (rngActive.Value = "-") Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
ElseIf (rngActive.Value = "N/A") Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
ElseIf (rngActive.Value = 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Else
|
|
If (rngActive.Text = "0") Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, rngActive.Value, activeSheet
|
|
End If
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
|
|
Sub replaceInSlide5(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
Dim activeSheet As Integer
|
|
activeSheet = 6
|
|
updateStatus "replaceInSlide5"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide5" & textCell & ":" & textCell
|
|
If (Chr(i) = "E" Or Chr(i) = "I") Then
|
|
If (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Else
|
|
If (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "(" & Abs(rngActive.Value) & ")", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, rngActive.Value, activeSheet
|
|
End If
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
Sub replaceInSlide6(startChar As String, endChar As String, startNum As Integer, endNum As Integer)
|
|
' msgbox startChar & startNum
|
|
' msgbox endChar & endNum
|
|
|
|
Dim i As Integer
|
|
Dim j As Integer
|
|
Dim textCell As Variant
|
|
Dim activeSheet As Integer
|
|
activeSheet = 7
|
|
updateStatus "replaceInSlide6"
|
|
|
|
For i = Asc(startChar) To Asc(endChar)
|
|
For j = startNum To endNum
|
|
textCell = Chr(i) & j
|
|
Set rngActive = Range(textCell & ":" & textCell)
|
|
updateStatus "replaceInSlide6" & textCell & ":" & textCell
|
|
|
|
If (rngActive.Value >= 1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "100" & "%", activeSheet
|
|
ElseIf (rngActive.Value = -0.1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "0" & "%", activeSheet
|
|
ElseIf (rngActive.Value < -1) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "N/A", activeSheet
|
|
ElseIf (rngActive.Value < 0) Then
|
|
ReplaceInPowerPoint "\E" & textCell, "-", activeSheet
|
|
Else
|
|
ReplaceInPowerPoint "\E" & textCell, Round(rngActive.Value * 100, 0) & "%", activeSheet
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
End Sub
|
|
|
|
Sub Main()
|
|
Set ppt = New PowerPoint.Application
|
|
Set pres = ppt.Presentations.Open(ActiveWorkbook.Path + "\" + "Template.pptx", msoFalse)
|
|
|
|
replaceInSlide0 "C", "I", 9, 17
|
|
replaceInSlide1 "C", "I",31, 38
|
|
replaceInSlide2 "B", "D",49, 58
|
|
replaceInSlide3 "C", "E",71, 74
|
|
replaceInSlide4 "B", "D", 79, 92
|
|
replaceInSlide5 "C", "E",102, 107
|
|
replaceInSlide6 "B", "D",119, 125
|
|
|
|
MsgBox "done"
|
|
|
|
End Sub
|
|
|
|
|
|
|