Run external program
FUNCTION RunExe(cmd)
CreateObject("WScript.Shell").Exec(cmd)
END FUNCTION
SUB CallExample
RunExe("c:\Program Files\Internet Explorer\iexplore.exe")
END SUB
Export object to Excel
FUNCTION ExcelExport(objID)
set obj = ActiveDocument.GetSheetObject( objID )
w = obj.GetColumnCount
if obj.GetRowCount>1001 then
h=1000
else
h=obj.GetRowCount
end if
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
objExcel.Worksheets(1).select()
objExcel.Visible = True
set CellMatrix = obj.GetCells2(0,0,w,h)
column = 1
for cc=0 to w-1
objExcel.Cells(1,column).Value = CellMatrix(0)(cc).Text objExcel.Cells(1,column).EntireRow.Font.Bold = True
column = column +1
next c = 1
r =2
for RowIter=1 to h-1
for ColIter=0 to w-1
objExcel.Cells(r,c).Value = CellMatrix(RowIter)(ColIter).Text
c = c +1
next r = r+1
c = 1
next
END FUNCTION
SUB CallExample ExcelExport( "CH01" )
END SUB
Export object to JPG
FUNCTION ExportObjectToJpg( ObjID, fName)
ActiveDocument.GetSheetObject(ObjID).ExportBitmapToFile
fName
END FUNCTION
SUB CallExample
ExportObjectToJpg "CH01", "C:\CH01Image.jpg"
END SUB
Save and exit QlikView
SUB SaveAndQuit ActiveDocument.Save
ActiveDocument.GetApplication.Quit
END SUB
Clone Dimension Group
SUB DuplicateGroups
SourceGroup = InputBox("Enter Source Group Name")
CopiesNo = InputBox("How many copies?")
SourceGroupProperties = ActiveDocument.GetGroup(SourceGroup).GetProperties
FOR i = 1 TO CopiesNo
SET DestinationGroup = ActiveDocument.CreateGroup(SourceGroupProperties.Name & "_" & i)
SET DestinationGroupProperties = DestinationGroup.GetProperties
IF SourceGroupProperties.IsCyclic THEN
DestinationGroupProperties.IsCyclic = true
DestinationGroup.SetProperties
DestinationGroupProperties
ELSE
SourceGroupProperties.IsCyclic = true
DestinationGroupProperties.SetProperties
SourceGroupProperties
END IF
SET Fields = SourceGroupProperties.FieldDefs
FOR c = 0 TO Fields.Count-1
SET fld = Fields(c)
DestinationGroup.AddField
fld.name
NEXT
Application.waitforidle
NEXT
END SUB
Open document with selection of current month
SUB DocumentOpen
ActiveDocument.Sheets("Intro").Activate
ActiveDocument.ClearAll (true)
ActiveDocument.Fields("YearMonth").Select
ActiveDocument.Evaluate("Date(MonthStart(Today(), 0),'MMM-YYYY')")
END SUB
Read and Write variables
FUNCTION getVariable(varName)
set v = ActiveDocument.Variables(varName)
getVariable = v.GetContent.String
END FUNCTION
SUB setVariable(varName, varValue)
set v = ActiveDocument.Variables(varName)
v.SetContent varValue, true
END SUB
Open QlikView application, reload, press a button and close (put the code in a .vbs file)
Set MyApp = CreateObject("QlikTech.QlikView")
Set MyDoc = MyApp.OpenDoc ("C:\QlikViewApps\Demo.qvw","","")
Set ActiveDocument = MyDoc
ActiveDocument.Reload
Set Button1 = ActiveDocument.GetSheetObject("BU01")
Button1.Press MyDoc.GetApplication.Quit
Set MyDoc = Nothing
Set MyApp = Nothing
Delete file
FUNCTION DeleteFile(rFile)
set oFile = createObject("Scripting.FileSystemObject")
currentStatus = oFile.FileExists(rFile)
if currentStatus = true than
oFile.DeleteFile(rFile)
end if
set oFile = Nothing
END FUNCTION
SUB CallExample
DeleteFile ("C:\MyFile.PDF")
END SUB
Get reports information
function countReports
set ri = ActiveDocument.GetDocReportInfo
countReports = ri.Count
end function
function getReportInfo
set ri = ActiveDocument.GetDocReportInfo
set r = ri.Item(i)
getReportInfo = r.Id & "," & r.Name & "," & r.PageCount & CHR(10)
end function
Send mail using Google Mail
SUB SendMail
Dim objEmail
Const cdoSendUsingPort = 2 ' Send the message using SMTP
Const cdoBasicAuth = 1 ' Clear-text authentication
Const cdoTimeout = 60 ' Timeout for SMTP in seconds
mailServer = "smtp.gmail.com"
SMTPport = 465
mailusername = "MyAccount@gmail.com"
mailpassword = "MyPassword"
mailto = "destination@company.com"
mailSubject = "Subject line"
mailBody = "This is the email body"
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword
.Update
End With
objEmail.To = mailto
objEmail.From = mailusername
objEmail.Subject = mailSubject
objEmail.TextBody = mailBody
objEmail.AddAttachment "C:\report.pdf"
objEmail.Send
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
END SUB
Changing Font setting of an Object
SUB Font()
set obj = ActiveDocument.GetSheetObject("BU01")
set fnt = obj.GetFrameDef.Font
fnt.PointSize1000 = fnt.PointSize1000 + 1000
fnt.FontName = "Calibri"
fnt.Bold = true
fnt.Italic = true
fnt.Underline = true
obj.SetFont fnt
END SUB
To Show and Hide Tab row
Sub ShowTab
rem Hides tabrow in document properties
set docprop = ActiveDocument.GetProperties
docprop.ShowTabRow=true
ActiveDocument.SetProperties docprop
End Sub
Sub HideTab
rem Hides tabrow in document properties
set docprop = ActiveDocument.GetProperties
docprop.ShowTabRow=false
ActiveDocument.SetProperties docprop
End Sub
Always One Selected Enable / Disable setting through Macro
Sub AlwaysOneSelected
set obj = ActiveDocument.GetSheetObject("LB02")
set boxfield=obj.GetField
set fprop = boxfield.GetProperties
fprop.OneAndOnlyOne = True
boxfield.SetProperties fprop
End Sub
Sub RemoveAlwaysOneSelected
set obj = ActiveDocument.GetSheetObject("LB02")
set boxfield=obj.GetField
set fprop = boxfield.GetProperties
fprop.OneAndOnlyOne = False
boxfield.SetProperties fprop
ActiveDocument.ClearAll True
End Sub
Reading Rows and Columns in a table object
Sub ReadStraightTable
Set Table = ActiveDocument.GetSheetObject( "CH01" )
For RowIter = 0 to table.GetRowCount-1
For ColIter = 0 to table.GetColumnCount-1
set cell = table.GetCell(RowIter,ColIter)
Msgbox(cell.Text)
Next
Next
End Sub
Get number of Rows in a Straight or Pivot tables
function ReadRowsCount
set v = ActiveDocument.GetVariable("variableName")
v.SetContent ActiveDocument.GetSheetObject( "CH01" ).GetRowCount-1, true
end function
Get and Set variable values in macros
function setVariable(name, value)
set v = ActiveDocument.GetVariable("variableName")
v.SetContent value,true
end function
function getVariable(name)
set v = ActiveDocument.GetVariable("variableName")
getVariable = v.GetContent.String
end function
Export chart data to QVD file, the chart may Bar/Line/StraightTable/Pivot etc.
sub ChartToQVD
set obj = ActiveDocument.GetSheetObject("CH01")
obj.ExportEx "QvdName.qvd", 4
end sub
Export Charts as image for each value selection in a Listbox
FUNCTION ExportObjectToJpg( ObjID, fName)
ctiveDocument.GetSheetObject(ObjID).ExportBitmapToFile fName
END FUNCTION
SUB ExportChartByListboxValues
DIM fname, value, filePath, timestamp
filePath = ActiveDocument.Variables("vPDFFlagPath").GetContent.STRING
timestamp = Year(Now()) & DatePart("m", Now()) & DatePart("d", Now()) & DatePart("h", Now()) & DatePart("n", Now()) & DatePart("s", Now())
SET Doc = ActiveDocument
fieldName = "EmployeeID"
SET Field = Doc.Fields(fieldName).GetPossibleValues
FOR index = 0 to Field.Count-1
Doc.Fields(fieldName).Clear
Doc.Fields(fieldName).SELECT
Field.Item(index).Text
fileName = Field.Item(index).Text & "_" & timestamp & ".jpg"'Field.Item(index).Text & DateValue
ExportObjectToJpg "CH420", filePath & fileName
NEXT
Doc.Fields(fieldName).Clear
END SUB
Checks whether given folder exists if not creates the given folder
Function CheckFolderExists(path)
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
If Not fileSystemObject.FolderExists(path) Than
fileSystemObject.CreateFolder(path)
End If
End Function
Minimize the chart object and move the chart position 20 pixels down and 15 right
Sub MoveChart
set mybox = ActiveDocument.GetSheetObject("CH09")
mybox.Minimize
set fr = mybox.GetFrameDef
pos = fr.MinimizedRect
pos.Top = pos.Top + 20
pos.Left = pos.Left + 15
mybox.SetFrameDef fr
end sub
Move Chart Object 20 pixels down and 15 right
Sub MoveChart
set obj = ActiveDocument.GetSheetObject("CH09")
pos = obj.GetRect
pos.Top = pos.Top + 20
pos.Left = pos.Left + 15
obj.SetRect pos
End Sub
Export Table charts Side by Side in a single Excel sheet
Function ExportCharts()
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = true
Set xlDoc = xlApp.Workbooks.Add 'open new workbook
nSheetsCount = 0
CALL RemoveDefaultSheet(xlDoc)
nSheetsCount = xlDoc.Sheets.Count
xlDoc.Sheets(nSheetsCount).Select
Set xlSheet = xlDoc.Sheets(nSheetsCount)
CALL ExportRevenueWidgets(xlDoc,xlSheet)
End Function
'Call Export Widgets By Sheet
Function ExportRevenueWidgets(xlDoc,xlSheet)
CALL Export(xlDoc,xlSheet,"CH09", "A")
CALL Export(xlDoc,xlSheet,"CH09", "D")
End Function
'Export Widgets
Function Export(xlDoc, xlSheet,widgetID, columnStart)
nRow = xlSheet.UsedRange.Rows.Count
nRow = 1
Set SheetObj = ActiveDocument.GetSheetObject(widgetID)
'Copy the chart object to clipboard
SheetObj.CopyTableToClipboard true
'Paste the chart object in Excel file
xlSheet.Paste xlSheet.Range(columnStart&nRow)
End Function
'Remove Default Sheets from Excel Files
Sub RemoveDefaultSheet(xlDoc)
Do
nSheetsCount = xlDoc.Sheets.Count
If nSheetsCount = 1 than
Exit Do
Else
xlDoc.Sheets(nSheetsCount).Select
xlDoc.ActiveSheet.Delete
End If
Loop
End Sub
Setting Scroll bar of a chart to Right side by default
SUB StartScrollRight
SET chartObject = ActiveDocument.GetSheetObject("CH01")
SET chartProperties = chartObject.GetProperties
chartProperties.ChartProperties.XScrollInitRight = true
chartObject.SetProperties chartProperties
END SUB
Show hide expression in Straight / Pivot table
Sub ShowHideExpression()
SET chartObj = ActiveDocument.GetSheetObject("CH01")
SET chartProp= chartObj.GetProperties
SET expr = chartProp.Expressions.Item(1).Item(0).Data.ExpressionData
expr.Enable = False // Hides First expression
SET expr = chartProp.Expressions.Item(2).Item(0).Data.ExpressionData
expr.Enable = True // Displays Second expression
End Sub
To reset InputField values
Sub ResetInputField
' Reset the InputField
set fld = ActiveDocument.Fields("InputFieldName")
fld.ResetInputFieldValues 0, 0 ' 0 = All
values reset, 1 = Reset Possible value, 2 = Reset single value
End Sub
To set InputField values
Sub SetInputField
set fld = ActiveDocument.Fields("Budget")
fld.SetInputFieldValue 0, "999" ' Sets InputField value to 999
End Sub
Clear specific Fields
SUB ClearFields
SET Doc = ActiveDocument
Doc.Fields(FieldName1).Clear
Doc.Fields(FieldName2).Clear
Doc.Fields(FieldName3).Clear
Doc.Fields(DateFieldNameN).Clear
END SUB
Export chart to CSV
SUB ExportChartToCSV
SET objChart = ActiveDocument.GetSheetObject("CH01")
objChart.Export "C:\Data.CSV", ", "
END SUB
Fit zoom to Window
Sub FitZoomToWindow
ActiveDocument.GetApplication.WaitForIdle
ActiveDocument.ActiveSheet.FItZoomToWindow
End Sub
Macro to get fast change chart type in a variable
10 - Pivot Table
11 - Straight Table
12 - Bar
15 - Line
Sub GetChartType()
set chart = ActiveDocument.getsheetobject("CH01")
set p = chart.GetProperties
set v = ActiveDocument.GetVariable("vFastChangeChartType")
v.SetContent
chart.GetObjectType,true
end sub
Open IE browser with URL based on a selected Dimension value - Use below macro in Document Properties Field Event Triggers
Create a variable
vSelectedURL : =Only([Image Location])
Sub Browse()
set v = ActiveDocument.GetVariable("vSelectedURL")
Set ie = CreateObject("Internetexplorer.Application")
ie.Visible = True
ie.Navigate v.GetContent.String
End Sub
Export multiple chart to Microsoft PowerPoint slides
Sub ExportPPT
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.open("YourPath\ppt.pptx")'file Path
Set PPSlide =objPresentation.Slides.Add(1,12)
ActiveDocument.GetSheetObject("CH1").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 150 'This sets the top location of the image
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 15 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 240
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 250
Set PPSlide = objPresentation.Slides.Add(1,12)
ActiveDocument.GetSheetObject("CH2").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 150 'This sets the top location of the image
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 15 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 100
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 200
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
Copy to Clip Board -Bit Map Image
Sub CopyObject
ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard
End sub
Append data to existing Excel file
Sub AppendDataToExcel
dim doc, xlApp, xlDoc, xlSheet, LastRow
Const xlUp = -4162
set doc = ActiveDocument
Set xlApp = CreateObject("Excel.Application")
Set xlDoc = xlApp.Workbooks.Open("C:\Data.xlsx") ' Change filepath
xlapp.Visible = true ' you can also set it to false so that process done in background
Set xlSheet = xlDoc.Worksheets("Sheet1") ' Replace Sheet1 with your sheet name
xlSheet.Activate
LastRow = xlSheet.Cells(xlSheet.Rows.Count, 1).End(xlUp).Row
msgbox LastRow
xlSheet.Cells(LastRow + 1, 1).Select
doc.GetSheetObject("TB01").CopyTableToClipboard true 'Replace TB01 with your chart object ID
xlSheet.Paste
xlDoc.Save
xlDoc.Close
xlApp.Quit
End Sub
Export all objects of a Container to Excel
sub Export
set oXL = CreateObject("Excel.Application")
oXL.DisplayAlerts = False
oXL.visible=True
Dim oXLDoc 'as Excel.Workbook
Dim i
Set oXLDoc = oXL.Workbooks.Add
'---------------------------------------
Set ContainerObj = ActiveDocument.GetSheetObject("CT02")
Set ContProp=ContainerObj.GetProperties
aSheetObj=Array("CH02","CH03","CH06")
'---------------------------------------
for i=0 to UBound(aSheetObj)
'ActiveDocument.GetApplication.WaitForIdle
oXL.Sheets.Add
oXL.ActiveSheet.Move ,oXL.Sheets( oXL.Sheets.Count )
ContProp.SingleObjectActiveIndex = i
ContainerObj.SetProperties ContProp
Set oSH = oXL.ActiveSheet
oSH.Range("A1").Select
Set obj = ActiveDocument.GetSheetObject(aSheetObj(i))
obj.CopyTableToClipboard True
oSH.Paste
sCaption=obj.GetCaption.Name.v
set obj=Nothing
oSH.Rows("1:1").Select
oXL.Selection.Font.Bold = True
oSH.Cells.Select
oXL.Selection.Columns.AutoFit
oSH.Range("A1").Select
oSH.Name=left(sCaption,30)
set oSH=Nothing
next
Call Excel_DeleteBlankSheets(oXLDoc)
oXL.DisplayAlerts = True
'// Finally select the first sheet
oXLDoc.Sheets(1).Select
'---------------------------------------
set oXL =Nothing
set oXLDoc =Nothing
end sub
Private Sub Excel_DeleteBlankSheets(ByRef oXLDoc)
For Each ws In oXLDoc.Worksheets
If (not HasOtherObjects(ws)) than
If oXLDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Than
On Error Resume Next
Call ws.Delete()
End If
End If
Next
End Sub
Public Function HasOtherObjects(ByRef objSheet) 'As Boolean
Dim c
If (objSheet.ChartObjects.Count > 0) Than
HasOtherObjects = true
Exit function
End If
If (objSheet.Pictures.Count > 0) Than
HasOtherObjects = true
Exit function
End If
If (objSheet.Shapes.Count > 0) Than
HasOtherObjects = true
Exit function
End If
HasOtherObjects = false
End Function
Get list of bookmarks in Variable
Sub GetBookmarks
bookmarks = ActiveDocument.GetDocBookmarkNames
dim BM
for i = lbound(bookmarks) to ubound(bookmarks)
if(i=0) then
BM="'"&bookmarks(i)&"'"
else
BM=BM&",'"&bookmarks(i)&"'"
end if
next
set v = ActiveDocument.GetVariable("vVariable")
v.SetContent BM,true
End Sub
Export charts for each bookmark in separate excel sheets
Function ExportCharts()
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = true
Set xlDoc = xlApp.Workbooks.Add 'open new workbook
nSheetsCount = 0
CALL RemoveDefaultSheet(xlDoc)
bookmarks = ActiveDocument.GetDocBookmarkNames
for i = lbound(bookmarks) to ubound(bookmarks)
ActiveDocument.RecallDocBookmark bookmarks(i)
nSheetsCount = xlDoc.Sheets.Count
msgbox nSheetsCount
xlDoc.Sheets(nSheetsCount).Select
Set xlSheet = xlDoc.Sheets(nSheetsCount)
msgbox xlSheet.Name
CALL ExportRevenueWidgets(xlDoc,xlSheet)
' set nSheetsCount = nSheetsCount + 1
if i <> ubound(bookmarks) than
xlDoc.Sheets.Add
xlDoc.ActiveSheet.Move ,xlDoc.Sheets( xlDoc.Sheets.Count )
end if
' msgbox xlDoc.Sheets.Count
next
End Function
'Call Export Widgets By Sheet
Function ExportRevenueWidgets(xlDoc,xlSheet)
CALL Export(xlDoc,xlSheet,"CH01", "A")
CALL Export(xlDoc,xlSheet,"CH02", "D")
End Function
'Export Widgets
Function Export(xlDoc, xlSheet,widgetID, columnStart)
nRow = xlSheet.UsedRange.Rows.Count
nRow = 1
Set SheetObj = ActiveDocument.GetSheetObject(widgetID)
'Copy the chart object to clipboard
SheetObj.CopyTableToClipboard true
'Paste the chart object in Excel file
xlSheet.Paste xlSheet.Range(columnStart&nRow)
End Function
'Remove Default Sheets from Excel Files
Sub RemoveDefaultSheet(xlDoc)
Do
nSheetsCount = xlDoc.Sheets.Count
If nSheetsCount = 1 than
Exit Do
Else
xlDoc.Sheets(nSheetsCount).Select
xlDoc.ActiveSheet.Delete
End If
Loop
End Sub
Showing posts with label Macro. Show all posts
Showing posts with label Macro. Show all posts
Opening Record Notes with a Keystroke in Microsoft Dynamics GP
We’ve heard that some Dynamics GP users bemoan the loss of a convenient keyboard function. Apparently, in older versions of GP, users could open record notes with a keystroke. Now, apparently, you need to take your hands off the keyboard and grab the mouse. Much less convenient.
Try this...
That's it! Now as you type along, just hit the keyboard shortcut associated with the macro and POOF! The Record Notes window opens without using the mouse. Keep in mind, this macro ONLY works for the one window that was opened when it was recorded. If shortcuts are needed for other windows, they need to be recorded individually and assigned to different keystrokes. And yes, other windows and functions can be opened with keystrokes by using macros.
Try this...
- Alt/F8 to start recording a macro while the desired window is open (suppose Sales Transaction Entry window).
- Name the macro.
- Next, use the mouse to open the appropriate Record Notes window. Once the Record Notes window is open, click on Alt/F8 again to stop the macro.
- Next, in the Navigation Pane, add a Macro Shortcut. Point to the macro just recorded and assign a Keyboard Shortcut key to the shortcut.
That's it! Now as you type along, just hit the keyboard shortcut associated with the macro and POOF! The Record Notes window opens without using the mouse. Keep in mind, this macro ONLY works for the one window that was opened when it was recorded. If shortcuts are needed for other windows, they need to be recorded individually and assigned to different keystrokes. And yes, other windows and functions can be opened with keystrokes by using macros.
Subscribe to:
Posts (Atom)