Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Access Dessin de formes sur Excel à partir de Access

Dessin de formes sur Excel à partir de Access

9 réponses
Avatar
Wendake
Bonjour,
vous pouvez mes suggérer un exemple pour créer une forme
(ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
lui donner un nom
ajouter backcolor et forecolor
écrire un texte
ajouter un hyperlink

Merci
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
yar-pol
Si vous voulez savoire comment augmenter vos revenu et pouvoir d'achat.
http://poldekp.getiblog.fr/



"Wendake" a écrit dans le message de
news:
Bonjour,
vous pouvez mes suggérer un exemple pour créer une forme
(ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
lui donner un nom
ajouter backcolor et forecolor
écrire un texte
ajouter un hyperlink

Merci




Avatar
Gilbert
Bonjour,

Le plus simple est de créer une macro dans un fichier Excel qui fait ce que
tu veux.
Ensuite tu récupère le code de cette macro et tu l'adaptes dans Access.

--
Cordialement,

Gilbert


"Wendake" a écrit dans le message de
news:
Bonjour,
vous pouvez mes suggérer un exemple pour créer une forme
(ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
lui donner un nom
ajouter backcolor et forecolor
écrire un texte
ajouter un hyperlink

Merci




Avatar
Wendake
C'est dans l'adaptation que j'ai les problèmes. Comment je peux convertir
"Selection.ShapeRange" pour ajouter du texte.
merci.


"Gilbert" a écrit dans le message de
groupe de discussion : #rm#
Bonjour,

Le plus simple est de créer une macro dans un fichier Excel qui fait ce
que
tu veux.
Ensuite tu récupère le code de cette macro et tu l'adaptes dans Access.

--
Cordialement,

Gilbert


"Wendake" a écrit dans le message de
news:
Bonjour,
vous pouvez mes suggérer un exemple pour créer une forme
(ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
lui donner un nom
ajouter backcolor et forecolor
écrire un texte
ajouter un hyperlink

Merci








Avatar
Gilbert
Bonjour,,
Voici la macro créée dans Excel
Sub Macro1()
'
ActiveSheet.Shapes.AddShape(msoShapeOval, 117#, 108.75, 265.5,
79.5).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.Characters.Text = "vdxbvn,h" & Chr(10) & "" & Chr(10) &
"lkjjml"
With Selection.Characters(Start:=1, Length:).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Characters(Start:, Length:=6).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1),
Address:= _
"http://www.test.com"
End Sub

et adaptée dans Access

Sub Macro1()
Dim XL_App As New Excel.Application
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim NomFichier As String

NomFichier = "C:Fichiertest.xls"
Set XL_App = CreateObject("Excel.Application")
With XL_App
.Workbooks.add
.DisplayAlerts = False
.ActiveWorkbook.SaveAs (NomFichier)
.DisplayAlerts = True
End With
Set XL_Classeur = XL_App.Workbooks.Open(NomFichier)
XL_App.Visible = True
Set XL_Feuille = XL_Classeur.Sheets(1)
'
XL_Feuille.Shapes.AddShape(msoShapeOval, 117#, 108.75, 265.5, 79.5).Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 13
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Characters.Text = "vdxbvn,h" & Chr(10) & "" & Chr(10) & "lkjjml"
With .Characters(Start:=1, Length:).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With .Characters(Start:, Length:=6).Font
.ColorIndex = 3
End With
XL_Feuille.Hyperlinks.add Anchor:=.ShapeRange.Item(1),
Address:="http://www.google.fr"
End With


Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing

End Sub



--
Cordialement,

Gilbert


"Wendake" a écrit dans le message de
news:%
C'est dans l'adaptation que j'ai les problèmes. Comment je peux convertir
"Selection.ShapeRange" pour ajouter du texte.
merci.


"Gilbert" a écrit dans le message de
groupe de discussion : #rm#
> Bonjour,
>
> Le plus simple est de créer une macro dans un fichier Excel qui fait ce
> que
> tu veux.
> Ensuite tu récupère le code de cette macro et tu l'adaptes dans Access.
>
> --
> Cordialement,
>
> Gilbert
>
>
> "Wendake" a écrit dans le message de
> news:
>> Bonjour,
>> vous pouvez mes suggérer un exemple pour créer une forme
>> (ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
>> lui donner un nom
>> ajouter backcolor et forecolor
>> écrire un texte
>> ajouter un hyperlink
>>
>> Merci
>>
>>
>
>


Avatar
Gilbert
J'ai oublié pour le nom

après la ligne
With Selection
ajoute celle-ci
.Name = "LeNomQuiVaBien"


--
Cordialement,

Gilbert


"Gilbert" a écrit dans le message de
news:%23$
Bonjour,,
Voici la macro créée dans Excel
Sub Macro1()
'
ActiveSheet.Shapes.AddShape(msoShapeOval, 117#, 108.75, 265.5,
79.5).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.Characters.Text = "vdxbvn,h" & Chr(10) & "" & Chr(10) &
"lkjjml"
With Selection.Characters(Start:=1, Length:).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Characters(Start:, Length:=6).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1),
Address:= _
"http://www.test.com"
End Sub

et adaptée dans Access

Sub Macro1()
Dim XL_App As New Excel.Application
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim NomFichier As String

NomFichier = "C:Fichiertest.xls"
Set XL_App = CreateObject("Excel.Application")
With XL_App
.Workbooks.add
.DisplayAlerts = False
.ActiveWorkbook.SaveAs (NomFichier)
.DisplayAlerts = True
End With
Set XL_Classeur = XL_App.Workbooks.Open(NomFichier)
XL_App.Visible = True
Set XL_Feuille = XL_Classeur.Sheets(1)
'
XL_Feuille.Shapes.AddShape(msoShapeOval, 117#, 108.75, 265.5, 79.5).Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 13
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Characters.Text = "vdxbvn,h" & Chr(10) & "" & Chr(10) & "lkjjml"
With .Characters(Start:=1, Length:).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With .Characters(Start:, Length:=6).Font
.ColorIndex = 3
End With
XL_Feuille.Hyperlinks.add Anchor:=.ShapeRange.Item(1),
Address:="http://www.google.fr"
End With


Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing

End Sub



--
Cordialement,

Gilbert


"Wendake" a écrit dans le message de
news:%
> C'est dans l'adaptation que j'ai les problèmes. Comment je peux


convertir
> "Selection.ShapeRange" pour ajouter du texte.
> merci.
>
>
> "Gilbert" a écrit dans le message de
> groupe de discussion : #rm#
> > Bonjour,
> >
> > Le plus simple est de créer une macro dans un fichier Excel qui fait


ce
> > que
> > tu veux.
> > Ensuite tu récupère le code de cette macro et tu l'adaptes dans


Access.
> >
> > --
> > Cordialement,
> >
> > Gilbert
> >
> >
> > "Wendake" a écrit dans le message de
> > news:
> >> Bonjour,
> >> vous pouvez mes suggérer un exemple pour créer une forme
> >> (ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
> >> lui donner un nom
> >> ajouter backcolor et forecolor
> >> écrire un texte
> >> ajouter un hyperlink
> >>
> >> Merci
> >>
> >>
> >
> >




Avatar
Wendake
Merci!

"Gilbert" a écrit dans le message de
groupe de discussion : #$
Bonjour,,
Voici la macro créée dans Excel
Sub Macro1()
'
ActiveSheet.Shapes.AddShape(msoShapeOval, 117#, 108.75, 265.5,
79.5).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.Characters.Text = "vdxbvn,h" & Chr(10) & "" & Chr(10) &
"lkjjml"
With Selection.Characters(Start:=1, Length:).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Characters(Start:, Length:=6).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1),
Address:= _
"http://www.test.com"
End Sub

et adaptée dans Access

Sub Macro1()
Dim XL_App As New Excel.Application
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim NomFichier As String

NomFichier = "C:Fichiertest.xls"
Set XL_App = CreateObject("Excel.Application")
With XL_App
.Workbooks.add
.DisplayAlerts = False
.ActiveWorkbook.SaveAs (NomFichier)
.DisplayAlerts = True
End With
Set XL_Classeur = XL_App.Workbooks.Open(NomFichier)
XL_App.Visible = True
Set XL_Feuille = XL_Classeur.Sheets(1)
'
XL_Feuille.Shapes.AddShape(msoShapeOval, 117#, 108.75, 265.5, 79.5).Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 13
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Characters.Text = "vdxbvn,h" & Chr(10) & "" & Chr(10) & "lkjjml"
With .Characters(Start:=1, Length:).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With .Characters(Start:, Length:=6).Font
.ColorIndex = 3
End With
XL_Feuille.Hyperlinks.add Anchor:=.ShapeRange.Item(1),
Address:="http://www.google.fr"
End With


Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing

End Sub



--
Cordialement,

Gilbert


"Wendake" a écrit dans le message de
news:%
C'est dans l'adaptation que j'ai les problèmes. Comment je peux convertir
"Selection.ShapeRange" pour ajouter du texte.
merci.


"Gilbert" a écrit dans le message de
groupe de discussion : #rm#
> Bonjour,
>
> Le plus simple est de créer une macro dans un fichier Excel qui fait ce
> que
> tu veux.
> Ensuite tu récupère le code de cette macro et tu l'adaptes dans Access.
>
> --
> Cordialement,
>
> Gilbert
>
>
> "Wendake" a écrit dans le message de
> news:
>> Bonjour,
>> vous pouvez mes suggérer un exemple pour créer une forme
>> (ExlWS.Shapes.AddShape(msoShapeOval, x, y, w, z).xxxx) et après:
>> lui donner un nom
>> ajouter backcolor et forecolor
>> écrire un texte
>> ajouter un hyperlink
>>
>> Merci
>>
>>
>
>






Avatar
Wendake
Salut,
J'ai fait des modifications pour mes besoins et après des essais il
fonctionne.

Le problème est que si j'ouvre l'application et j'exécute le code j'ai une
erreur au moment de nommer la forme crée (variable de bloc With non
définie), mais si j'arrête le code et je réexécute, tout fonctionne.

Mon code jusqu'à l'erreur est le suivant.


Dim ExlApp As New Excel.Application
Dim ExlWB As Excel.Workbook
Dim ExlWS As Excel.Worksheet
Dim xc, yc, LineaLen, DimSize, FH, FW, X, y, BoxW, BoxH As Long
Dim IncrRadians, wDimCount As Byte
Dim i, z As Integer
Dim wStrNomeFile As String

xc = 330
yc = 170
LineaLen = 160
DimSize = 80
BoxW = 100
BoxH = 70
wDimCount = 5
wStrNomeFile = "D:VarieAccessDWDataModelTempSchema.xlsx"
'Gestione nome file

Set ExlApp = CreateObject("Excel.Application")
With ExlApp
.Workbooks.Add
.DisplayAlerts = False
.ActiveWorkbook.SaveAs (wStrNomeFile)
.DisplayAlerts = True
End With
Set ExlWB = ExlApp.Workbooks.Open(wStrNomeFile)
ExlApp.Visible = True
Set ExlWS = ExlWB.Sheets(1)
'<<<<<<<<<<< Un foglio ogni fact
'Determina quante dimensioni
IncrRadians = (2 * ExlApp.WorksheetFunction.Pi()) / wDimCount
'Disegna le dimensioni
Do Until z = wDimCount
i = i + 1
X = xc + (Round(Sin(i * IncrRadians), 3) * LineaLen)
y = yc - (Round(Cos(i * IncrRadians), 3) * LineaLen)
ExlWS.Shapes.AddLine(xc + DimSize / 2, yc + DimSize / 2, X + DimSize
/ 2, y + DimSize / 2).Select
ExlWS.Shapes.AddShape(msoShapeOval, X, y, DimSize, DimSize).Select
With Selection
.Name = "AAAAAAAAAAAA" & z
'<----------------- ERREUR
Avatar
Wendake
Après des récherches j'ai vu que le task Excel.exe reste ouvert, même si je
vais finir mon code avec:
Set ExlWS = Nothing
Set ExlWB = Nothing
Set ExlApp = Nothing
est-ce qu'il est normal?



"Wendake" a écrit dans le message de news:

Salut,
J'ai fait des modifications pour mes besoins et après des essais il
fonctionne.

Le problème est que si j'ouvre l'application et j'exécute le code j'ai une
erreur au moment de nommer la forme crée (variable de bloc With non
définie), mais si j'arrête le code et je réexécute, tout fonctionne.

Mon code jusqu'à l'erreur est le suivant.


Dim ExlApp As New Excel.Application
Dim ExlWB As Excel.Workbook
Dim ExlWS As Excel.Worksheet
Dim xc, yc, LineaLen, DimSize, FH, FW, X, y, BoxW, BoxH As Long
Dim IncrRadians, wDimCount As Byte
Dim i, z As Integer
Dim wStrNomeFile As String

xc = 330
yc = 170
LineaLen = 160
DimSize = 80
BoxW = 100
BoxH = 70
wDimCount = 5
wStrNomeFile = "D:VarieAccessDWDataModelTempSchema.xlsx" 'Gestione
nome file

Set ExlApp = CreateObject("Excel.Application")
With ExlApp
.Workbooks.Add
.DisplayAlerts = False
.ActiveWorkbook.SaveAs (wStrNomeFile)
.DisplayAlerts = True
End With
Set ExlWB = ExlApp.Workbooks.Open(wStrNomeFile)
ExlApp.Visible = True
Set ExlWS = ExlWB.Sheets(1) '<<<<<<<<<<< Un foglio ogni fact
'Determina quante dimensioni
IncrRadians = (2 * ExlApp.WorksheetFunction.Pi()) / wDimCount
'Disegna le dimensioni
Do Until z = wDimCount
i = i + 1
X = xc + (Round(Sin(i * IncrRadians), 3) * LineaLen)
y = yc - (Round(Cos(i * IncrRadians), 3) * LineaLen)
ExlWS.Shapes.AddLine(xc + DimSize / 2, yc + DimSize / 2, X +
DimSize / 2, y + DimSize / 2).Select
ExlWS.Shapes.AddShape(msoShapeOval, X, y, DimSize, DimSize).Select
With Selection
.Name = "AAAAAAAAAAAA" & z '<----------------- ERREUR




Avatar
Wendake
Mieux encore:

With ExlApp
.DisplayAlerts = False
.ActiveWorkbook.Save
.DisplayAlerts = True
.Workbooks.Close
.Quit
End With
Set ExlWS = Nothing
Set ExlWB = Nothing
Set ExlApp = Nothing





"Wendake" a écrit dans le message de news:

Salut,
J'ai fait des modifications pour mes besoins et après des essais il
fonctionne.

Le problème est que si j'ouvre l'application et j'exécute le code j'ai une
erreur au moment de nommer la forme crée (variable de bloc With non
définie), mais si j'arrête le code et je réexécute, tout fonctionne.

Mon code jusqu'à l'erreur est le suivant.


Dim ExlApp As New Excel.Application
Dim ExlWB As Excel.Workbook
Dim ExlWS As Excel.Worksheet
Dim xc, yc, LineaLen, DimSize, FH, FW, X, y, BoxW, BoxH As Long
Dim IncrRadians, wDimCount As Byte
Dim i, z As Integer
Dim wStrNomeFile As String

xc = 330
yc = 170
LineaLen = 160
DimSize = 80
BoxW = 100
BoxH = 70
wDimCount = 5
wStrNomeFile = "D:VarieAccessDWDataModelTempSchema.xlsx" 'Gestione
nome file

Set ExlApp = CreateObject("Excel.Application")
With ExlApp
.Workbooks.Add
.DisplayAlerts = False
.ActiveWorkbook.SaveAs (wStrNomeFile)
.DisplayAlerts = True
End With
Set ExlWB = ExlApp.Workbooks.Open(wStrNomeFile)
ExlApp.Visible = True
Set ExlWS = ExlWB.Sheets(1) '<<<<<<<<<<< Un foglio ogni fact
'Determina quante dimensioni
IncrRadians = (2 * ExlApp.WorksheetFunction.Pi()) / wDimCount
'Disegna le dimensioni
Do Until z = wDimCount
i = i + 1
X = xc + (Round(Sin(i * IncrRadians), 3) * LineaLen)
y = yc - (Round(Cos(i * IncrRadians), 3) * LineaLen)
ExlWS.Shapes.AddLine(xc + DimSize / 2, yc + DimSize / 2, X +
DimSize / 2, y + DimSize / 2).Select
ExlWS.Shapes.AddShape(msoShapeOval, X, y, DimSize, DimSize).Select
With Selection
.Name = "AAAAAAAAAAAA" & z '<----------------- ERREUR