Friday 3 February 2017

VBA code for adding progress bar.

Private Sub UserForm_Initialize()
    lblProgressBar.Width = 0
    lblProgressBar.BackColor = RGB(4, 217, 39)
    If Application.International(xlCountryCode) = 49 Then       'German
        ufProgressBar.Caption = "Ihre Anfrage wird bearbeitet..."
    Else
        ufProgressBar.Caption = "Processing Your Request. Please Wait..."
    End If
   
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
    End If
End Sub

ufProgressBar.Show vbModeless
ufProgressBar.Caption = "Importing data into worksheets " & obj.index & " of " & wb.Sheets.Count
                ufProgressBar.lblProgressBar.Width = CInt((obj.index * 100) / (wb.Sheets.Count)) * ufProgressBar.Width / 100
                ufProgressBar.Repaint

Unload ufProgressBar

Sunday 29 January 2017

How to update chart data range using vba

shtName.ChartObjects("Chart 3").Activate
ActiveChart.SetSourceData Source:=shtAdmin.Range("$A$15:$H" & LR1)

Export workbook .XLSM format to .XLS format.

Sub ExportWorkbook()
    Dim wb As Workbook
    Dim strPunitName As String
    Dim wbName As String

   Application.DisplayAlerts = False
    On Error GoTo Last
    Set wb = ThisWorkbook
    strPunitName = wb.Sheets(home).Range("C20").Value
    wbName = ThisWorkbook.Path & Application.PathSeparator & Trim(strPunitName) & ".xls" '&    Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStr(ThisWorkbook.Name, "."))
    If wbName <> vbNullString Then
    ThisWorkbook.SaveCopyAs FileName:=wbName
    End If
Application.DisplayAlerts = True
Last:
    If Err.Description <> vbNullString Then
    MsgBox Err.Description, vbInformation, title
    End
    End If
End Sub


Saturday 28 January 2017

change label to percentage in bar graph excel using vba macro

Sub set_data_labels_to_bar_chart1()

Dim i As Integer
Dim j As Integer
Dim s As Double
Dim v As Variant

Dim NoDigits As Integer
Dim PercentFormat As String
Dim myTxt As String

NoDigits = 1 'How many digits to round Millions toPercentFormat = "0.0%" 'Format string for the Percentages
With ActiveChart
  For i = 1 To .SeriesCollection.Count
  .SeriesCollection(i).HasDataLabels = True
  Next i
 
  For i = 1 To .SeriesCollection(1).Points.Count
  s = 0
   
  For j = 1 To .SeriesCollection.Count
  v = .SeriesCollection(j).Values
  s = s + v(i)
  Next j
   
  For j = 1 To .SeriesCollection.Count
  v = .SeriesCollection(j).Values
  myTxt = Round(v(i) / 1000000#, NoDigits) & "M, " & Format(v(i) / s, PercentFormat)
  .SeriesCollection(j).Points(i).DataLabel.Text = myTxt
   
  If v(i) <= 0 Then .SeriesCollection(j).Points(i).DataLabel.Delete
  Next j
  Next i
End With
End Sub