Dessin de formes sur Excel à partir de Access

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
yar-pol
Le #18225301
Si vous voulez savoire comment augmenter vos revenu et pouvoir d'achat.
http://poldekp.getiblog.fr/



"Wendake" 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




Gilbert
Le #18227581
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" 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




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


"Gilbert" 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" 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








Gilbert
Le #18228991
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" news:%
C'est dans l'adaptation que j'ai les problèmes. Comment je peux convertir
"Selection.ShapeRange" pour ajouter du texte.
merci.


"Gilbert" 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" > 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
>>
>>
>
>


Gilbert
Le #18229111
J'ai oublié pour le nom

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


--
Cordialement,

Gilbert


"Gilbert" 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" news:%
> C'est dans l'adaptation que j'ai les problèmes. Comment je peux


convertir
> "Selection.ShapeRange" pour ajouter du texte.
> merci.
>
>
> "Gilbert" > 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" > > 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
> >>
> >>
> >
> >




Wendake
Le #18229511
Merci!

"Gilbert" 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" news:%
C'est dans l'adaptation que j'ai les problèmes. Comment je peux convertir
"Selection.ShapeRange" pour ajouter du texte.
merci.


"Gilbert" 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" > 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
>>
>>
>
>






Wendake
Le #18257541
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
Wendake
Le #18258011
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"
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




Wendake
Le #18260111
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"
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




Publicité
Poster une réponse
Anonyme