excel 单击/使用VBA宏模拟单击

qv7cva1a  于 2023-06-25  发布在  其他
关注(0)|答案(2)|浏览(185)

我期待写一个VBA宏,将执行或单击一个按钮,从SAP Analysis for Office plug-in在功能区。
目前,我有一个工作的替代方案,使用热键的功能区选项卡和按钮,我发送使用SendKeys在我的VBA宏,但它不够强大,因为不同的用户可能有不同的功能区布局,因此不同的热键组合相同的功能。
这是我想以编程方式单击的按钮。

您能否帮助我使用当前推荐的Office fluent Ribbon概念来实现这一点?
编辑:宏录制器不录制功能区上的操作。
编辑2:我相信我得到了包含Analysis功能区结构的XML文件。下面是我需要的按钮结构的截图。

yzxexxkh

yzxexxkh1#

我找到了一种方法,使用MS提供的UIAutomation框架来实现这一点,该框架可以在您的项目中引用为UIAutomationClient
代码如下:

'global object to hold the translations
 Dim translations As Object

Public Enum oConditions
  eUIA_NamePropertyId
  eUIA_AutomationIdPropertyId
  eUIA_ClassNamePropertyId
End Enum

'element name translations for English
Function getEnglishTranslations() As Object
  Set Words = CreateObject("Scripting.Dictionary")
  'element, element name
  Words.Add "Analysis", "Analysis"
  Words.Add "Lower Ribbon", "Lower Ribbon"
  Words.Add "Design Panel Group", "Design Panel"
  Words.Add "Design Panel Menu", "Design Panel"
  Words.Add "Display Button", "Display"

  Set getEnglishTranslations = Words
End Function

'element name translations for German
Function getGermanTranslations() As Object
   Set Words = CreateObject("Scripting.Dictionary")

   'element, element name
   Words.Add "Analysis", "Analysis"
   Words.Add "Lower Ribbon", "Unteres Menüband"
   Words.Add "Design Panel Group", "Designbereich"
   Words.Add "Design Panel Menu", "Designbereich"
   Words.Add "Display Button", "Anzeigen"

   Set getGermanTranslations = Words
End Function

Function translate(element As String) As String
    translate = translations(element)
End Function

Sub toggleDisplay()
    Application.ScreenUpdating = False

    Dim oAutomation As New CUIAutomation 'the UI Automation Object

    'references for elements in the UI tree
    Dim root As IUIAutomationElement
    Dim xl As IUIAutomationElement
    Dim analysisTab As IUIAutomationElement
    Dim xlrib As IUIAutomationElement
    Dim dpanel As IUIAutomationElement
    Dim display As IUIAutomationElement

    'pattern objects which allow the execution of different UI elements' 
    functionality
    Dim oTogglePattern As IUIAutomationTogglePattern
    Dim expcolPattern As IUIAutomationExpandCollapsePattern
    Dim selPattern As IUIAutomationSelectionItemPattern

    'multi-clause condition references to locate the UI elements in the UI 
    tree.
    Dim analysisCond As IUIAutomationCondition
    Dim displayCond As IUIAutomationCondition
    Dim disPanelCond As IUIAutomationCondition

   'stores the language code for the current active language
   Dim languageCode As Integer

   'get the active application language
   languageCode = _
   Application.International(XlApplicationInternational.xlCountryCode)

   'choose the language dictionary based on the active language
   If languageCode = 49 Then
       Set translations = getGermanTranslations
   Else
       Set translations = getEnglishTranslations
   End If

   'get a reference to the UI element tree
   Set root = oAutomation.GetRootElement

   'locate the Excel window
   Set xl = root.FindFirst(TreeScope_Descendants, PropCondition(oAutomation, 
   eUIA_NamePropertyId, _
   "test wb for hidden ribbon - new (delete me).xlsm - Excel"))

   'click the Analysis tab
   Set analysisCond = _ 
   oAutomation.CreateAndCondition(PropCondition(oAutomation, 
   eUIA_NamePropertyId, translate("Analysis")), _
   PropCondition(oAutomation, eUIA_ClassNamePropertyId, "NetUIRibbonTab"))
   Set analysisTab = xl.FindFirst(TreeScope_Descendants, analysisCond)
   Set selPattern = _ 
   analysisTab.GetCurrentPattern(UIA_SelectionItemPatternId)
   selPattern.Select

   'locate the Design Panel Group
   Set xlrib = xl.FindFirst(TreeScope_Descendants, 
   PropCondition(oAutomation, eUIA_NamePropertyId, translate("Lower 
   Ribbon")))

   Set dpanel = xlrib.FindFirst(TreeScope_Descendants, 
   PropCondition(oAutomation, eUIA_NamePropertyId, translate("Design Panel 
   Group")))

   'try locating the Display button
   Set displayCond = _ 
   oAutomation.CreateAndCondition(PropCondition(oAutomation, 
   eUIA_NamePropertyId, translate("Display Button")), _
   PropCondition(oAutomation, eUIA_ClassNamePropertyId, 
   "NetUIRibbonButton"))

   Set display = dpanel.FindFirst(TreeScope_Descendants, displayCond)

   'true when the window is shrunk to a point where the display button
   'is part of the dropdown menu under Design Panel
   If display Is Nothing Then

       'expand the Design Panel dropdown first
       Set disPanelCond = _ 
       oAutomation.CreateAndCondition(PropCondition(oAutomation, 
       eUIA_NamePropertyId, translate("Design Panel Menu")), _

       PropCondition(oAutomation, eUIA_ClassNamePropertyId, "NetUIAnchor"))
       Set dpanel = dpanel.FindFirst(TreeScope_Descendants, disPanelCond)
       Set expcolPattern = _ 
       dpanel.GetCurrentPattern(UIA_ExpandCollapsePatternId)
       expcolPattern.Expand

      'attempt to locate the Display button again
      Set display = dpanel.FindFirst(TreeScope_Descendants, displayCond)
   End If

   'Click the Display button programmatically (FINALLY!!!)
   Set oTogglePattern = display.GetCurrentPattern(UIA_TogglePatternId)
   oTogglePattern.Toggle

   Application.ScreenUpdating = True
End Sub

'generate a Condition object with the string to be matched against the 
selected property
Function PropCondition(UiAutomation As CUIAutomation, Prop As oConditions, 
Requirement As String) As IUIAutomationCondition
Select Case Prop
    Case 0
          Set PropCondition = _
          UiAutomation.CreatePropertyCondition(UIA_NamePropertyId, 
          Requirement)
    Case 1
          Set PropCondition = _ 
          UiAutomation.CreatePropertyCondition(UIA_AutomationIdPropertyId, 
          Requirement)
    Case 2
          Set PropCondition = _
          UiAutomation.CreatePropertyCondition(UIA_ClassNamePropertyId, 
          Requirement)
    End Select
End Function

不幸的是,我用这种方法遇到了another problem,到目前为止我还没有解决方案。
这里有一个video,你可以观看它来帮助你开始。

7jmck4yq

7jmck4yq2#

sry还不能发表评论,希望我已经正确理解了。
你有没有尝试为Ribbon设置常量值?

Me.RibbonName = "YourRibbonNameFromUsysRibbons"

您可以在此处找到功能区名称:
https://www.spreadsheet1.com/office-excel-ribbon-imagemso-icons-gallery-page-01.html
希望我帮到你了。
祝你今天愉快

相关问题