Materi Perkuliahan

Membuat Media Fungsi Grfaik dengan VBA Excel

Dipublikasikan pada : 7 Februari 2021.

Sub rumus()
On Error Resume Next
Dim lembar As Worksheet
Dim gambar1 As Shape
Dim gambar2 As Shape
Dim gambar3 As Shape
Dim gambar4 As Shape
ReDim himpunan(0 To 20 * Range(“B5”), 0 To 1) As Single
Set lembar = Worksheets(1)
d = lembar.Shapes(“titik”).Left + lembar.Shapes(“titik”).Width / 2
e = lembar.Shapes(“titik”).Top + lembar.Shapes(“titik”).Height / 2
f = Range(“B7”)
lembar.Shapes(“garis1”).Delete
lembar.Shapes(“garis2”).Delete
lembar.Shapes(“kurva”).Delete
Set gambar1 = lembar.Shapes.AddLine(d – 100, e, d + 100, e)
gambar1.Name = “garis1”
With lembar.Shapes(“garis1”)
.Line.ForeColor.RGB = vbRed
.Line.Weight = 2
End With
Set gambar2 = lembar.Shapes.AddLine(d, e – 100, d, e + 100)
gambar2.Name = “garis2”
With lembar.Shapes(“garis2”)
.Line.ForeColor.RGB = vbRed
.Line.Weight = 2
End With
j = 0
For i = 0 To 20 * Range(“B5”)
j = (i – 10 * Range(“B5”)) / 10
a = Range(“A2”).Formula
b = Application.ConvertFormula(a, xlA1, xlA1, xlAbsolute)
c = Application.WorksheetFunction.Substitute(b, “x”, j)
himpunan(i, 0) = d + j * (100 / Range(“B5”))
himpunan(i, 1) = e – Evaluate(c) * f
Next i
Set gambar3 = lembar.Shapes.AddPolyline(himpunan)
gambar3.Name = “kurva”
With lembar.Shapes(“kurva”)
.Line.ForeColor.RGB = vbBlue
.Line.Weight = 2
End With
If lembar.Shapes(“kontrol”).TextFrame2.TextRange.Text = “ON” Then
d1 = Range(“A15”)
e1 = Range(“C15”)
For k = d1 To e1
l = (k – 10 * Range(“B5”)) / 10
a1 = Range(“A2”).Formula
b1 = Application.ConvertFormula(a1, xlA1, xlA1, xlAbsolute)
c1 = Application.WorksheetFunction.Substitute(b1, “x”, j)
‘Set gambar4 = lembar.Shapes.AddShape(msoShapeOval, d + l, e, f, g)
Next k
End If
End Sub
Sub kelipatan()
Range(“B7”) = Range(“B7”) + 1
Call rumus
End Sub
Sub perkecil()
Range(“B7”) = Range(“B7”) – 1
Call rumus
End Sub
Sub kontrol_x_tambah()
Range(“B5”) = Range(“B5”) + 1
Call rumus
End Sub
Sub kontrol_x_kurang()
Range(“B5”) = Range(“B5”) – 1
Call rumus
End Sub
Sub aktif()
Dim lembar As Worksheet
Set lembar = Worksheets(1)
If lembar.Shapes(“kontrol”).TextFrame2.TextRange.Text = “OFF” Then
lembar.Shapes(“kontrol”).TextFrame2.TextRange.Text = “ON”
lembar.Shapes(“kontrol”).Fill.ForeColor.RGB = vbYellow
lembar.Shapes(“kontrol”).TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
Else
lembar.Shapes(“kontrol”).TextFrame2.TextRange.Text = “OFF”
lembar.Shapes(“kontrol”).Fill.ForeColor.RGB = vbBlue
lembar.Shapes(“kontrol”).TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbWhite
End If
End Sub