Home > Computer security programming > Another Way Of Doing Macro In Excel By Yopi

Another Way Of Doing Macro In Excel By Yopi

April 29th, 2009

Do you feel tired to do something repeatedly? Or you often repeat the same event over and over again. Well, this is the time you do some macro job. Macro consists of very wide useable capabilities. So we have to point to some specialized kind of macro to do our specific jobs. This time we will be creating a macro that makes the header of a letter, programmatically. There’s a lot of source out there by the same mean, but this me, yopibest. I do something I believe is useful for somebody, at least for me. Enough talks, lets built our macro.

For make it simple, first you might want to download the finished macro in this link. Extract and open the file, there will be step by step until finished task to do. Or you can read further more at If you already know how to start using VBA, just follow the simple steps bellow.
Assume that you already opened the “Visual Basic Editor” by pressing ALT-F11. Create a module and type this code now:

Sub Kop()
‘By Yopibest©2009
Dim FileName As String
FileName = “”
Dim KolomAkhir As String
Dim KolomAwal As String
Dim Lebar As Single
On Error GoTo Salah
KolomAwal = Awal
KolomAkhir = Akhir
Dim cekKolomAwal As String
Dim cekKolomAkhir As String
cekKolomAwal = Awal
cekKolomAkhir = Akhir
Dim i As Integer
Dim Col As Integer
Dim intKolom As Integer
Dim JlhKolom As Integer
JlhKolom = (AscW(cekKolomAkhir) – AscW(cekKolomAwal))
For Col = 0 To JlhKolom
For i = 1 To 4
Range(cekKolomAwal & i).Select
If IsEmpty(ActiveCell.Value) = False Then
Call Salah
Exit Sub
End If
Next i
intKolom = AscW(cekKolomAwal) + 1
cekKolomAwal = Chr(intKolom)
Next Col
Range(KolomAwal & “1″, KolomAkhir & “1″).Select
Selection.Merge
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.FormulaR1C1 = “FIRST LINE”
ActiveCell.Font.Name = “Bookman Old Style”
ActiveCell.Font.Size = 11
Range(KolomAwal & “2″, KolomAkhir & “2″).Select
Selection.Merge
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.FormulaR1C1 = “SECOND LINE”
ActiveCell.Font.Name = “Bookman Old Style”
ActiveCell.Font.Size = 11
Range(KolomAwal & “3″, KolomAkhir & “3″).Select
Selection.Merge
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.FormulaR1C1 = “THIRD LINE”
ActiveCell.Font.Name = “Bookman Old Style”
ActiveCell.Font.Size = 12
Range(KolomAwal & “4″, KolomAkhir & “4″).Select
Selection.Merge
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.FormulaR1C1 = “FOURTH LINE”
ActiveCell.Font.Name = “Bookman Old Style”
ActiveCell.Font.Size = 10
Selection.Font.Underline = xlUnderlineStyleDouble
Range(KolomAwal & “1″, KolomAkhir & “1″).Select
If NamaFile = “” Then
If NamaFile = “” Then
MsgBox “You didn’t specified Logo File”, vbOKOnly, “Logo”
Else
MsgBox “Logo File is missing “, vbOKOnly, “Logo”
End If
Call Margin
Windows(”MacroKop.xls”).Close
Exit Sub
End If
If UCase$(KolomAwal) = “A” Then
Lebar = Selection.Width
ActiveSheet.Pictures.Insert(NamaFile).Select
Selection.Left = (Lebar – (351 + ((Lebar – 351) / 2)) – 48)
Selection.ShapeRange.PictureFormat.ColorType = msoPictureBlackAndWhite
Else
Range(”A1″, KolomAwal & “1″).Select
Lebar = Selection.Width
Range(KolomAwal & “1″, KolomAkhir & “1″).Select
Lebar = Lebar – Selection.Width
ActiveSheet.Pictures.Insert(NamaFile).Select
Selection.Left = Lebar
Selection.ShapeRange.PictureFormat.ColorType = msoPictureBlackAndWhite
End If
Selection.Top = 0
Range(KolomAwal & “1″, KolomAkhir & “4″).Select
Call Margin
Windows(”MacroKop.xls”).Close
Exit Sub
Salah:
MsgBox “You did not perform a selection.” & vbCrLf & vbCrLf & _
“Make the selection along the column header first.”, vbInformation, “Anda Keliru !!!!!!”
Windows(”MacroKop.xls”).Close
End Sub

Sub Margin()
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.590551181102362)
.BottomMargin = Application.InchesToPoints(0.590551181102362)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.CenterHorizontally = True
.Order = xlDownThenOver
End With
End Sub

Function Awal()
‘By Yopibest©2009
Dim str As String, strArr() As String
Dim Int1 As Integer, Int2 As Integer
str = Replace(Selection.Address, “$”, “”)
strArr = Split(str, “:”)
Int1 = AscW(UCase(Mid$(strArr(0), 1, 1)))
Int2 = AscW(UCase(Mid$(strArr(0), 2, 1)))
If Int1 = 65 Then
If Int2 = 65 Then
Awal = Chr(Int1) & Chr(Int2)
Else
Awal = Chr(Int1)
End If
End If
End Function

Function Akhir()
‘By Yopibest©2009
Dim str As String, strArr() As String
Dim Int1 As Integer, Int2 As Integer
str = Replace(Selection.Address, “$”, “”)
strArr = Split(str, “:”)
Int1 = AscW(UCase(Mid$(strArr(1), 1, 1)))
Int2 = AscW(UCase(Mid$(strArr(1), 2, 1)))
If Int1 = 65 Then
If Int2 = 65 Then
Akhir = Chr(Int1) & Chr(Int2)
Else
Akhir = Chr(Int1)
End If
End If
End Function

Sub Salah()
MsgBox “The table have to be make under the 5th record.” & vbCrLf & _
“Thus, there will be 5 empty rows above the tabel.” & vbCrLf & vbCrLf & _
“.”, vbInformation, “Anda Keliru !!!!!!”
Windows(”MacroKop.xls”).Close
End Sub

Note: you must sign your macro before you use it. All can be done by creating you own Digital Certificate for VBA Project. For this reason, you should download file in this link for assistance.
Hope this is useful. You can read more at yopi.

Grab pragmatic knowledge about Techniques – read this webpage.



system Computer security programming

  1. No comments yet.
  1. No trackbacks yet.