XL 2019 Macro créer une nouvelle section dans OneNote

[netparty]

Bonjour à tous

Est-il possible depuis Excel de créer un nouveau fichier Onenote et de nommer une section

Merci d'avance

Bonne journée

 

[Staple1600]

Bonjour le fil

En guise d'inspiration
(NB: Il faudra faire adaptation au niveau du nom de "l'imprimante" OneNote)

Spoiler: Réduit pour gain de place

Sub PushExcelContentToOneNote()
'*******************************************************************************
' Description:  This will take the selected content and print it to OneNote, then
'               reset the printer back to the original printer prior to the routine.
'
' Author:       Scott Lyerly
' Contact:      scott_lyerly@tjx.com, or scott.c.lyerly@gmail.com
'
' Name:                             Date:           Init:   Modification:
' PushExcelContentToOneNote V1      21-MAR-2014     SCL     Original development
'
' Arguments:    None
'
' Returns:      None
'*******************************************************************************
On Error GoTo ErrHandler
    ' Constant declaratios.
    Const sONENOTE_PRINTER      As String = "Send To OneNote 2010 on nul:"
    ' Variable declarations.
    Dim sOriginalPrinter        As String
    ' Get the original printer first.
    sOriginalPrinter = Application.ActivePrinter
    ' Make sure One Note is the active printer.
    Application.ActivePrinter = sONENOTE_PRINTER
    ' Print to OneNote
    Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    ' Reset the original printer.
    Application.ActivePrinter = sOriginalPrinter
Exit_Clean:
    Exit Sub
ErrHandler:
    ' Since the 1004 error number is too broad, we'll check the error description instead.
    If InStr(Err.Description, "ActivePrinter") = 0 Then
        MsgBox "Excel cannot find the OneNote printer on your machine." & _
               vbNewLine & vbNewLine & _
               "Operation cancelled.", _
               vbOKOnly + vbExclamation, "PRINTER ERROR"
    Else
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "MICROSOFT ERROR"
    End If
    Resume Exit_Clean
End Sub


'To set the keystroke, add the following in the ThisWorkbook module.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^+n", ""
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^+n", "PushExcelContentToOneNote"
End Sub

 

[netparty]

Bonjour le fil

En guise d'inspiration
(NB: Il faudra faire adaptation au niveau du nom de "l'imprimante" OneNote)

Spoiler: Réduit pour gain de place

Sub PushExcelContentToOneNote()
'*******************************************************************************
' Description:  This will take the selected content and print it to OneNote, then
'               reset the printer back to the original printer prior to the routine.
'
' Author:       Scott Lyerly
' Contact:      scott_lyerly@tjx.com, or scott.c.lyerly@gmail.com
'
' Name:                             Date:           Init:   Modification:
' PushExcelContentToOneNote V1      21-MAR-2014     SCL     Original development
'
' Arguments:    None
'
' Returns:      None
'*******************************************************************************
On Error GoTo ErrHandler
    ' Constant declaratios.
    Const sONENOTE_PRINTER      As String = "Send To OneNote 2010 on nul:"
    ' Variable declarations.
    Dim sOriginalPrinter        As String
    ' Get the original printer first.
    sOriginalPrinter = Application.ActivePrinter
    ' Make sure One Note is the active printer.
    Application.ActivePrinter = sONENOTE_PRINTER
    ' Print to OneNote
    Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    ' Reset the original printer.
    Application.ActivePrinter = sOriginalPrinter
Exit_Clean:
    Exit Sub
ErrHandler:
    ' Since the 1004 error number is too broad, we'll check the error description instead.
    If InStr(Err.Description, "ActivePrinter") = 0 Then
        MsgBox "Excel cannot find the OneNote printer on your machine." & _
               vbNewLine & vbNewLine & _
               "Operation cancelled.", _
               vbOKOnly + vbExclamation, "PRINTER ERROR"
    Else
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "MICROSOFT ERROR"
    End If
    Resume Exit_Clean
End Sub


'To set the keystroke, add the following in the ThisWorkbook module.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^+n", ""
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^+n", "PushExcelContentToOneNote"
End Sub

Bonjour @Staple1600

Merci pour les infos,

Mais comment puis-je d'abord créer un nouveau bloc note Onenote

Bonne journée

 

[Staple1600]

Re

Je viens de tester ce bout de code
(fonctionne sur mon PC => Office 365)
la macro est lancée à partir d'Excel
(OneNote est ouvert au préalable)

Spoiler: Réduit pour gain de place

Ci dessous le code à tester
Ne oublier de cocher les références idoines dans VBE

'The following References were active in the writing of this code:

'Visual Basic for Applications, Microsoft Excel 16.0 Object Library
'OLE Automation, Microsoft Office 16.0 Object Library
'Microsoft OneNote 15.0 Extended Object Library
'Microsoft OneNote 15.0 Object Library
'Microsoft XML, v6.0.


Sub OneNotePagemaker()
' Macro to create pages in a specified OneNote section
' from a list in Excel.

    ' Activate OneNote Application
    Dim oneNote As oneNote.Application
    Set oneNote = New oneNote.Application
    Dim MyRange As Excel.Range

    ' Opens File Dialog box.  User selects the section (a
    ' .one file) the new pages will be added to
    Dim Fname As String
    Fname = Application.GetOpenFilename( _
            FileFilter:="Microsoft OneNote Section (*.one), *.one", _
            Title:="Select OneNote Section for New Pages")
    
    ' Opens the OneNote section (hierarchy) specified by the
    ' user.  The ID of the section is assigned to "idString"
    Dim idString As String
    oneNote.OpenHierarchy Fname, "", idString

    ' Define ranges.  pageTitle.Formula will be the name of
    ' the individual pages
    Dim pageTitle As Range
    Set MyRange = Range("A:A")
    
    ' Cycle through the list with the desired page titles
    For Each pageTitle In MyRange
    
        ' Checks to make sure that the cell is not empty
        If Not pageTitle.Formula = "" Then
                
            ' Creates a new page in the section chosen above (idString)
            ' ID of new page is assigned to "newPage" string
            Dim newPage As String
            oneNote.CreateNewPage idString, newPage

            ' Extract page content from the new page so it can be parsed
            ' as XML.  OneNote uses XML so changes must be made to the XML
            ' itself
            Dim pageContent As String
            oneNote.GetPageContent newPage, pageContent
            Dim pageXml As MSXML2.DOMDocument60
            Set pageXml = New MSXML2.DOMDocument60
            pageXml.LoadXML (pageContent)
            
            ' Create pageElement to be used to define individual nodes
            Dim pageElement As MSXML2.IXMLDOMElement
            Set pageElement = pageXml.DocumentElement
            
            ' Define node that is above the CDATA Node
            ' The CDATA node holds the page Title
            Dim CDATAParent As MSXML2.IXMLDOMNode
            Set CDATAParent = pageElement.ChildNodes.Item(2).FirstChild.FirstChild
            
            ' Define node that holds empty CDATA Node so that it can be replaced
            Dim oldDataNode As MSXML2.IXMLDOMNode
            Set oldDataNode = pageElement.ChildNodes.Item(2).FirstChild.FirstChild.FirstChild
            
             ' Create new CDATA node with new Title (identified as pageTitle.Formula)
            Dim newNameNode As MSXML2.IXMLDOMCDATASection
            Set newNameNode = pageXml.createCDATASection(pageTitle.Formula)
            
            ' Remove empty CDATA node
            CDATAParent.RemoveChild oldDataNode
            ' Append the node above the CDATA node with the new, named CDATA node
            CDATAParent.appendChild newNameNode
            ' Update the PageContent of the XML so the title does not get overwritten
            oneNote.UpdatePageContent pageXml.XML
            
        End If
    
    Next
    
End Sub

 

[netparty]

Re

Je viens de tester ce bout de code
(fonctionne sur mon PC => Office 365)
la macro est lancée à partir d'Excel
(OneNote est ouvert au préalable)

Spoiler: Réduit pour gain de place

Ci dessous le code à tester
Ne oublier de cocher les références idoines dans VBE

'The following References were active in the writing of this code:

'Visual Basic for Applications, Microsoft Excel 16.0 Object Library
'OLE Automation, Microsoft Office 16.0 Object Library
'Microsoft OneNote 15.0 Extended Object Library
'Microsoft OneNote 15.0 Object Library
'Microsoft XML, v6.0.


Sub OneNotePagemaker()
' Macro to create pages in a specified OneNote section
' from a list in Excel.

    ' Activate OneNote Application
    Dim oneNote As oneNote.Application
    Set oneNote = New oneNote.Application
    Dim MyRange As Excel.Range

    ' Opens File Dialog box.  User selects the section (a
    ' .one file) the new pages will be added to
    Dim Fname As String
    Fname = Application.GetOpenFilename( _
            FileFilter:="Microsoft OneNote Section (*.one), *.one", _
            Title:="Select OneNote Section for New Pages")
   
    ' Opens the OneNote section (hierarchy) specified by the
    ' user.  The ID of the section is assigned to "idString"
    Dim idString As String
    oneNote.OpenHierarchy Fname, "", idString

    ' Define ranges.  pageTitle.Formula will be the name of
    ' the individual pages
    Dim pageTitle As Range
    Set MyRange = Range("A:A")
   
    ' Cycle through the list with the desired page titles
    For Each pageTitle In MyRange
   
        ' Checks to make sure that the cell is not empty
        If Not pageTitle.Formula = "" Then
               
            ' Creates a new page in the section chosen above (idString)
            ' ID of new page is assigned to "newPage" string
            Dim newPage As String
            oneNote.CreateNewPage idString, newPage

            ' Extract page content from the new page so it can be parsed
            ' as XML.  OneNote uses XML so changes must be made to the XML
            ' itself
            Dim pageContent As String
            oneNote.GetPageContent newPage, pageContent
            Dim pageXml As MSXML2.DOMDocument60
            Set pageXml = New MSXML2.DOMDocument60
            pageXml.LoadXML (pageContent)
           
            ' Create pageElement to be used to define individual nodes
            Dim pageElement As MSXML2.IXMLDOMElement
            Set pageElement = pageXml.DocumentElement
           
            ' Define node that is above the CDATA Node
            ' The CDATA node holds the page Title
            Dim CDATAParent As MSXML2.IXMLDOMNode
            Set CDATAParent = pageElement.ChildNodes.Item(2).FirstChild.FirstChild
           
            ' Define node that holds empty CDATA Node so that it can be replaced
            Dim oldDataNode As MSXML2.IXMLDOMNode
            Set oldDataNode = pageElement.ChildNodes.Item(2).FirstChild.FirstChild.FirstChild
           
             ' Create new CDATA node with new Title (identified as pageTitle.Formula)
            Dim newNameNode As MSXML2.IXMLDOMCDATASection
            Set newNameNode = pageXml.createCDATASection(pageTitle.Formula)
           
            ' Remove empty CDATA node
            CDATAParent.RemoveChild oldDataNode
            ' Append the node above the CDATA node with the new, named CDATA node
            CDATAParent.appendChild newNameNode
            ' Update the PageContent of the XML so the title does not get overwritten
            oneNote.UpdatePageContent pageXml.XML
           
        End If
   
    Next
   
End Sub

Merci
Bonne journée