Selva’s Site

Option Explicit
Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Label
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single
'________________________________________
Private Sub UserForm_Initialize()
    m_AddResizer
End Sub
'________________________________________
Private Sub UserForm_Terminate()
    Me.Controls.Remove MResizer
End Sub
'________________________________________
Private Sub m_AddResizer()
'
'add resizing control to bottomright corner of form
'
Set m_objResizer = Me.Controls.Add _
    ("Forms.label.1", MResizer, True)
With m_objResizer
  With .Font
      .Name = "Marlett"
      .Charset = 2
      .Size = 14
      .Bold = True
  End With
  .BackStyle = fmBackStyleTransparent
  .AutoSize = True
  .BorderStyle = fmBorderStyleNone
  .Caption = "o"
  .MousePointer = fmMousePointerSizeNWSE
  .ForeColor = RGB(100, 100, 100)
  .ZOrder
  .Top = Me.InsideHeight - .Height
  .Left = Me.InsideWidth - .Width
End With
End Sub
'________________________________________
Private Sub m_objResizer_MouseDown( _
            ByVal Button As Integer, _
            ByVal Shift As Integer, _
            ByVal X As Single, _
            ByVal Y As Single)
    If Button = 1 Then
        m_sngLeftResizePos = X
        m_sngTopResizePos = Y
        m_blnResizing = True
    End If
End Sub
'________________________________________
Private Sub m_objResizer_MouseMove( _
            ByVal Button As Integer, _
            ByVal Shift As Integer, _
            ByVal X As Single, _
            ByVal Y As Single)
  If Button = 1 Then
    With m_objResizer
      .Move .Left + X _
            - m_sngLeftResizePos, _
            .Top + Y - m_sngTopResizePos
      Me.Width = Me.Width + _
            X - m_sngLeftResizePos
      Me.Height = Me.Height + Y - m_sngTopResizePos
      .Left = Me.InsideWidth - .Width
      .Top = Me.InsideHeight - .Height
    End With
  End If
End Sub
'________________________________________
Private Sub m_objResizer_MouseUp( _
            ByVal Button As Integer, _
            ByVal Shift As Integer, _
            ByVal X As Single, _
            ByVal Y As Single)
    If Button = 1 Then
        m_blnResizing = False
    End If
End Sub

'__________________________________________________
'**************************************************
'*
'* MODULE NAME:     <<>>
'* AUTHOR:          Selva V Pasupathy,
'*                  HSBC Global Resourcing, Hyderabad
'* CONTACT:         socko@rediffmail.com
'__________________________________________________
Option Explicit
Sub Export_Chart2GIF()
'   Before exporting a chart need to select one
  Const PathSEP = "/"
  Const sPicType$ = ".gif"
  Dim sChartname
  Dim myPath
  Dim thisbook
  Dim myChart As ChartObject

  On Error Resume Next
'   If there is no chart object on this sheet,
'   let the user know about this
  Set myChart = ActiveSheet.ChartObjects(1)
  If myChart Is Nothing Then
    MsgBox "There are no charts on this sheet", 0
    Exit Sub
  End If

  If ActiveChart Is Nothing Then
    MsgBox "Please select a chart before exporting ", 0
    Exit Sub
  End If

ProcStart:
sChartname = Application.InputBox("Please Specify a name " & _
              "for the exported chart" & vbCr & _
              "There is no default name available" & vbCr & _
              "The chart will be saved in the same " & _
              "folder as this file", "Chart Export", "")

'   User presses "OK" without entering a name
  If sChartname = Empty Then
    MsgBox "You have not entered a " & _
        "name for this chart", _
        , "Invalid Entry"
    GoTo ProcStart
  End If

'   Test for Cancel button
    If sChartname = "False" Then
        Exit Sub
    End If

'   If a name was given, chart is exported
'   as a picture in the same
'   folder location as their current file
  thisbook = ActiveWorkbook.Path
  myPath = thisbook & PathSEP & _
        sChartname & sPicType
  ActiveChart.Export Filename:= _
      myPath, FilterName:="GIF"
End Sub