Another Method Of Creating Macro In Excel By Yopibest

Do you feel tired to do something repeatedly? Or you often do 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, a href=http://yopibest.blogspot.com/ target=_blankyopibest/a. I do something I believe is useful for somebody, at least for me. Enough talks, lets built our macro.br /
br /
For make it simple, then 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.br /
Assume that you already opened the “Visual Basic Editor” by pressing ALT-F11. Create a module and type this code now:br /
br /
Sub Kop()br /
By Yopibest©2009br /
Dim FileName As Stringbr /
FileName = br /
Dim KolomAkhir As Stringbr /
Dim KolomAwal As Stringbr /
Dim Lebar As Singlebr /
On Error GoTo Salahbr /
KolomAwal = Awalbr /
KolomAkhir = Akhirbr /
Dim cekKolomAwal As Stringbr /
Dim cekKolomAkhir As Stringbr /
cekKolomAwal = Awalbr /
cekKolomAkhir = Akhirbr /
Dim i As Integerbr /
Dim Col As Integerbr /
Dim intKolom As Integerbr /
Dim JlhKolom As Integerbr /
JlhKolom = (AscW(cekKolomAkhir) - AscW(cekKolomAwal))br /
For Col = 0 To JlhKolombr /
For i = 1 To 4br /
Range(cekKolomAwal i).Selectbr /
If IsEmpty(ActiveCell.Value) = False Thenbr /
Call Salahbr /
Exit Subbr /
End Ifbr /
Next ibr /
intKolom = AscW(cekKolomAwal) + 1br /
cekKolomAwal = Chr(intKolom)br /
Next Colbr /
Range(KolomAwal 1, KolomAkhir 1).Selectbr /
Selection.Mergebr /
ActiveCell.HorizontalAlignment = xlCenterbr /
ActiveCell.FormulaR1C1 = FIRST LINEbr /
ActiveCell.Font.Name = Bookman Old Stylebr /
ActiveCell.Font.Size = 11br /
Range(KolomAwal 2, KolomAkhir 2).Selectbr /
Selection.Mergebr /
ActiveCell.HorizontalAlignment = xlCenterbr /
ActiveCell.FormulaR1C1 = SECOND LINEbr /
ActiveCell.Font.Name = Bookman Old Stylebr /
ActiveCell.Font.Size = 11br /
Range(KolomAwal 3, KolomAkhir 3).Selectbr /
Selection.Mergebr /
ActiveCell.HorizontalAlignment = xlCenterbr /
ActiveCell.FormulaR1C1 = THIRD LINEbr /
ActiveCell.Font.Name = Bookman Old Stylebr /
ActiveCell.Font.Size = 12br /
Range(KolomAwal 4, KolomAkhir 4).Selectbr /
Selection.Mergebr /
ActiveCell.HorizontalAlignment = xlCenterbr /
ActiveCell.FormulaR1C1 = FOURTH LINEbr /
ActiveCell.Font.Name = Bookman Old Stylebr /
ActiveCell.Font.Size = 10br /
Selection.Font.Underline = xlUnderlineStyleDoublebr /
Range(KolomAwal 1, KolomAkhir 1).Selectbr /
If NamaFile = Thenbr /
If NamaFile = Thenbr /
MsgBox You didn’t specified Logo File, vbOKOnly, Logobr /
Elsebr /
MsgBox Logo File is missing , vbOKOnly, Logobr /
End Ifbr /
Call Marginbr /
Windows(MacroKop.xls).Closebr /
Exit Subbr /
End Ifbr /
If UCase$(KolomAwal) = A Thenbr /
Lebar = Selection.Widthbr /
ActiveSheet.Pictures.Insert(NamaFile).Selectbr /
Selection.Left = (Lebar - (351 + ((Lebar - 351) / 2)) - 48)br /
Selection.ShapeRange.PictureFormat.ColorType = msoPictureBlackAndWhitebr /
Elsebr /
Range(A1, KolomAwal 1).Selectbr /
Lebar = Selection.Widthbr /
Range(KolomAwal 1, KolomAkhir 1).Selectbr /
Lebar = Lebar - Selection.Widthbr /
ActiveSheet.Pictures.Insert(NamaFile).Selectbr /
Selection.Left = Lebarbr /
Selection.ShapeRange.PictureFormat.ColorType = msoPictureBlackAndWhitebr /
End Ifbr /
Selection.Top = 0br /
Range(KolomAwal 1, KolomAkhir 4).Selectbr /
Call Marginbr /
Windows(MacroKop.xls).Closebr /
Exit Subbr /
Salah:br /
MsgBox You did not choose a selection. vbCrLf vbCrLf _br /
Make the selection along the column header first., vbInformation, Anda Keliru !!!!!!br /
Windows(MacroKop.xls).Closebr /
End Subbr /
br /
Sub Margin()br /
With ActiveSheet.PageSetupbr /
.LeftMargin = Application.InchesToPoints(0.393700787401575)br /
.RightMargin = Application.InchesToPoints(0.393700787401575)br /
.TopMargin = Application.InchesToPoints(0.590551181102362)br /
.BottomMargin = Application.InchesToPoints(0.590551181102362)br /
.HeaderMargin = Application.InchesToPoints(0.511811023622047)br /
.FooterMargin = Application.InchesToPoints(0.511811023622047)br /
.CenterHorizontally = Truebr /
.Order = xlDownThenOverbr /
End Withbr /
End Subbr /
br /
Function Awal()br /
By Yopibest©2009br /
Dim str As String, strArr() As Stringbr /
Dim Int1 As Integer, Int2 As Integerbr /
str = Replace(Selection.Address, $, )br /
strArr = Split(str, :)br /
Int1 = AscW(UCase(Mid$(strArr(0), 1, 1)))br /
Int2 = AscW(UCase(Mid$(strArr(0), 2, 1)))br /
If Int1 = 65 Thenbr /
If Int2 = 65 Thenbr /
Awal = Chr(Int1) Chr(Int2)br /
Elsebr /
Awal = Chr(Int1)br /
End Ifbr /
End Ifbr /
End Functionbr /
br /
Function Akhir()br /
By Yopibest©2009br /
Dim str As String, strArr() As Stringbr /
Dim Int1 As Integer, Int2 As Integerbr /
str = Replace(Selection.Address, $, )br /
strArr = Split(str, :)br /
Int1 = AscW(UCase(Mid$(strArr(1), 1, 1)))br /
Int2 = AscW(UCase(Mid$(strArr(1), 2, 1)))br /
If Int1 = 65 Thenbr /
If Int2 = 65 Thenbr /
Akhir = Chr(Int1) Chr(Int2)br /
Elsebr /
Akhir = Chr(Int1)br /
End Ifbr /
End Ifbr /
End Functionbr /
br /
Sub Salah()br /
MsgBox The table have to be created under the 5th record. vbCrLf _br /
Thus, there will be 5 empty rows above the tabel. vbCrLf vbCrLf _br /
., vbInformation, Anda Keliru !!!!!!br /
Windows(MacroKop.xls).Closebr /
End Subbr /
br /
Note: you needto sign your macro before you use it. It can be done by creating you own Digital Certificate for VBA Project. For this reason, you should download file in this link for assistance.br /
Hope this is useful. You can read more at a href=http://yopibest.blogspot.com/2009/04/membuat-kop-secara-makro-menggunakan.html target=_blankyopi/a.br /
br /
Grab helpful recommendations about a href=http://techniquestips.com target=_blankTechniques/a - read quoted page.