[RESOLVED] Changing Font of Excel Cell value Using vb code

[firoz.raj]

can anybody tell me .How should i change the font of the Particular Cell Value.Kindly let me know
the idea.Any help would be highly appreciated.i simple want ExlSheet.Cells(2, 1).Value should be
in Bold.But all the text comming in Regular Format.Kindly let me know the idea.

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
'  Set excl = CreateObject(Excel.Application)
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "



        Set excl = Nothing
End Sub

[HanneSThEGreaT]

Simple :

Option Explicit

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
'  Set excl = CreateObject(Excel.Application)
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "

ExlSheet.Range("A2").Font.Bold = True 'Only Cell A2 Bold
ExlSheet.Range("A3:A5").Font.Italic = True 'A3 To A5 Italics
ExlSheet.Range("A6, A2").Font.Underline = True 'A2 and A6 Underline 
       Set excl = Nothing
End Sub

Note, I just added the Italics and Underline options as well, so that you can see how they also work

[firoz.raj]

Can you tell me .How should i insert the the logo means *.jpeg/Gif file in excelsheet.Here is the
Following Code .What i have written.Kindly let me know the idea.

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
'  Set excl = CreateObject(Excel.Application)
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "
         ExlSheet.Range("A1:A2").Font.Bold = True
       
          Set ExlSheet = Nothing
         Set wBook = Nothing
        Set excl = Nothing
End Sub

[HanneSThEGreaT]

You could use :

ActiveSheet.Pictures.Insert(FileName)

To get more complicated, you could even resize the picture, as shown here :

Option Explicit

Sub AddPicture(FileName As String, Target As Range)

Dim Pic As Object, PicTop As Double, PicLeft As Double, PicWidth As Double, PicHeight As Double
   
   'Determine If We Are On A WorkSheet
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
   'If Picture Source Doesn't Exist
    If Dir(FileName) = "" Then Exit Sub
    
    'Get Picture
    Set Pic = ActiveSheet.Pictures.Insert(FileName)
    
    ' Get Positions
    With Target
        PicTop = .Top
        PicLeft = .Left
        PicWidth = .Offset(0, .Columns.Count).Left - .Left
        PicHeight = .Offset(.Rows.Count, 0).Top - .Top
    End With
    
    ' Place Picture
    With Pic
        .Top = PicTop
        .Left = PicLeft
        .Width = PicWidth
        .Height = PicHeight
    End With
    
    'Release Memory
    Set Pic = Nothing
End Sub

Sub PlaceMyPicture()
'Get Picture And Place It In B5:B10
    AddPicture "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg", _
    Range("B5:D10")
End Sub

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "

ExlSheet.Range("A1:A2").Font.Bold = True 'Only Cell A1 & Cell A2 Bold


PlaceMyPicture
 
 Set ExlSheet = Nothing
 Set wBook = Nothing
 Set excl = Nothing
End Sub

[firoz.raj]

Still Not Working .i am getting errror Insert Method of Pictures Class is failed .Kindly let me know
the idea.Any help would be highly appreciated.here is the following Code .What i have written.

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
'  Set excl = CreateObject(Excel.Application)
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "
         ExlSheet.Range("A1:A2").Font.Bold = True
         ExlSheet.Range("A1:A2").Font.Italic = True
         ExlSheet.Range("A1:A5").Font.Underline = True
         ActiveSheet.Pictures.Insert (App.path & "FirmSignation.jpg")
       
          Set ExlSheet = Nothing
         Set wBook = Nothing
        Set excl = Nothing
End Sub

[HanneSThEGreaT]

Mine Works....

[firoz.raj]

But i am getting Type Mismatch Error .Here is the following Code what i have written.Kindly let me
Know the idea.

Public Sub PlacePicture()
AddPicture App.path & "\FirmSignation.jpg", _
    Range("B5:D10")

End Sub

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "

ExlSheet.Range("A1:A2").Font.Bold = True 'Only Cell A1 & Cell A2 Bold


PlaceMyPicture
 
 Set ExlSheet = Nothing
 Set wBook = Nothing
 Set excl = Nothing
End Sub

Sub AddPicture(FileName As String, Target As Range)

Dim Pic As Object, PicTop As Double, PicLeft As Double, PicWidth As Double, PicHeight As Double
   
   'Determine If We Are On A WorkSheet
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
   'If Picture Source Doesn't Exist
    If Dir(FileName) = "" Then Exit Sub
    
    'Get Picture
    Set Pic = ActiveSheet.Pictures.Insert(FileName)
    
    ' Get Positions
    With Target
        PicTop = .Top
        PicLeft = .Left
        PicWidth = .Offset(0, .Columns.Count).Left - .Left
        PicHeight = .Offset(.Rows.Count, 0).Top - .Top
    End With
    
    ' Place Picture
    With Pic
        .Top = PicTop
        .Left = PicLeft
        .Width = PicWidth
        .Height = PicHeight
    End With
    
    'Release Memory
    Set Pic = Nothing
End Sub

error genertation at this Following Line.

Public Sub PlacePicture()
AddPicture App.path & "\FirmSignation.jpg", _
    Range("B5:D10")

End Sub

[HanneSThEGreaT]

What version of Excel are you using ¿

[firoz.raj]

i am Using Excel 2003.Kindly let me know the idea.

[HanneSThEGreaT]

Then, honestly, frankly, I am clueless as to what your problem is

My version works in Excel 2003.

Suggestion :

Add your VB Project here, in Zip Format, and add your picture here as well.

We could then have a look and possibly suggest further.

[firoz.raj]

Thank You very much .Now it is Working .here is the following code what i have written.

Private Sub btPrint_Click()
Dim excl As Excel.Application
Dim wBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim m_SCompanyName As String
 m_SCompanyName = "AL ARABI FACTORY FOR STEEL WORKS      "
                

  Set excl = New Excel.Application
'  Set excl = CreateObject(Excel.Application)
  Set wBook = excl.Workbooks.Add
  Set ExlSheet = wBook.Worksheets(1)
         excl.Visible = True
         ExlSheet.Cells(2, 1).Value = m_SCompanyName
         ExlSheet.Cells(3, 1).Value = "P.O. BOX 14044 DAMMAM 31424  "
         ExlSheet.Cells(4, 1).Value = "KINGDOM OF SAUDI ARABIA      "
         ExlSheet.Cells(5, 1).Value = "PHONE :  (+9663) 812-3070    "
         ExlSheet.Cells(6, 1).Value = "FAX     :   (+9663) 812-3339 "
         ExlSheet.Range("A1:A2").Font.Bold = True
         ExlSheet.Range("A1:A2").Font.Italic = True
         ExlSheet.Range("A1:A5").Font.Underline = True
        ' ActiveSheet.Pictures.Insert (App.path & "FirmSignation.jpg"), Range("B5:D10")
       '  Call PlacePicture
       wBook.SaveAs App.path & "PurchaseOrder.Xls"
      ' wBook.Close savechanges:=True
          Set ExlSheet = Nothing
          Set wBook = Nothing
       '   excl.Quit
          Set excl = Nothing
End Sub
Public Sub PlacePicture()
AddPicture App.path & "\FirmSignation.jpg", _
    Range("B5:D10")

End Sub
Sub AddPicture(FileName As String, Target As Range)

Dim Pic As Object, PicTop As Double, PicLeft As Double, PicWidth As Double, PicHeight As Double
   
   'Determine If We Are On A WorkSheet
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
   'If Picture Source Doesn't Exist
    If Dir(FileName) = "" Then Exit Sub
    
    'Get Picture
    Set Pic = ActiveSheet.Pictures.Insert(FileName)
    
    ' Get Positions
    With Target
        PicTop = .Top
        PicLeft = .Left
        PicWidth = .Offset(0, .Columns.Count).Left - .Left
        PicHeight = .Offset(.Rows.Count, 0).Top - .Top
    End With
    
    ' Place Picture
    With Pic
        .Top = PicTop
        .Left = PicLeft
        .Width = PicWidth
        .Height = PicHeight
    End With
    
    'Release Memory
    Set Pic = Nothing
End Sub