[Digressions] Shapes your booty, Fractales et consorts...

Dranreb

Dranreb

XLDnaute Barbatruc
C'est en effet un ensemble de Julia visualisé sur un plan complexe inversé (les parties au centre sont les plus éloignées du centre dans la vue normale).
 
Dranreb

Dranreb

XLDnaute Barbatruc
Bon, je cite provisoirement un bout de module qui fabrique des .bmp :
VB: 
Option Explicit
Rem. Conventions API (Application Programming Interface)
Type BITMAP
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type
Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type
Private Declare Function GetObjectType Lib "gdi32.dll" (ByVal hgdiobj As Long) As Long
Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" _
   (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" _
   (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pRGBQuad As RGBQUAD) As Long
Private Declare Function SetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pcRGBQuad As RGBQUAD) As Long

Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
 
Declare Sub MoveMM Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal L As Long)
Declare Sub MoveAM Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, Source As Any, ByVal L As Long)
Declare Sub MoveMA Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, ByVal SrcA As Long, ByVal L As Long)
Declare Sub MoveAA Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, ByVal SrcA As Long, ByVal L As Long)

Dim ChNomF As String, LgL As Long, NbCoul As Long, LgE As Long, LgM As Long, LgF As Long
Dim Oct As Byte, BitPx As Integer, Succès As Boolean, Feui As Worksheet
'
Public XbmMax As Long, Xbm As Long
Public YbmMax As Long, Ybm As Long
Public TE() As Double, TH() As Double, TJ() As Double, TA() As Double
Sub InitCalculImage(Feuille As Worksheet)
Set Feui = Feuille
ChNomF = Replace(Range("RéfFicSor").Value, vbLf, "\")
XbmMax = Feui.Range("XbmMax").Value
YbmMax = Feui.Range("YbmMax").Value
Tâche "Calcul image", XbmMax * YbmMax
ReDim TE(1 To XbmMax, 1 To YbmMax) As Double
ReDim TH(1 To XbmMax, 1 To YbmMax) As Double
ReDim TJ(1 To XbmMax, 1 To YbmMax) As Double
ReDim TA(1 To XbmMax, 1 To YbmMax) As Double
End Sub
'

Sub ÉcritureImage(ByVal Img As Image)
Succès = FichierProduitParAPI(Img)
If Not Succès Then ÉcrireFichierBMP
If Succès Then
   MàJImage Img
   On Error Resume Next
   Dim G As Chart: Set G = Feui.ChartObjects("GImage").Chart: If Err Then Exit Sub
   G.Axes(xlCategory).MaximumScale = XbmMax
   G.Axes(xlValue).MaximumScale = YbmMax
   G.Axes(xlCategory).TickLabels.AutoScaleFont = False
   G.Axes(xlValue).TickLabels.AutoScaleFont = False
   Dim Divi As Long: On Error Resume Next: Divi = ActiveSheet.[DivGraph].Value: If Err Then Divi = 1
   On Error GoTo 0
   G.Axes(xlCategory).MajorUnit = Divi
   G.Axes(xlValue).MajorUnit = Divi
   G.PlotArea.Fill.UserPicture PictureFile:=ChNomF
   G.CopyPicture
   GphIsoEchelles G
   End If
End Sub
'

Function FichierProduitParAPI(Img As Image) As Boolean
Dim BmAPI As BITMAP, AdresseMap As Long, TbOct() As Byte
Tâche "Production de l'image (plan A)", XbmMax * YbmMax
On Error Resume Next
Img.Picture = LoadPicture(ChNomF)
If Err Then
    AbandonTâche "nouveau fichier": FichierProduitParAPI = False: Exit Function: End If
On Error GoTo 0
If GetObject(Img.Picture, Len(BmAPI), BmAPI) = 0 Then
    AbandonTâche "objet non obtenu": FichierProduitParAPI = False: Exit Function: End If
With BmAPI
   If .bmWidth <> XbmMax Or .bmHeight <> YbmMax Or .bmBitsPixel <> 24 Then
      AbandonTâche "caractéristiques image trop différentes"
      FichierProduitParAPI = False: Exit Function: End If
   LgL = .bmWidthBytes: AdresseMap = .bmBits: End With
ReDim TbOct(1 To LgL * YbmMax) As Byte
For Xbm = 1 To XbmMax: For Ybm = 1 To YbmMax
   Enrg = TE(Xbm, Ybm): Chal = TH(Xbm, Ybm): Gaît = TJ(Xbm, Ybm)
   Call CalcÉngEHJ: CalcRVBÉLi
   TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + 1) = Round(Bleu)
   TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + 2) = Round(Vert)
   TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + 3) = Round(Roug)
   Call OùÇaEnEst: Next Ybm: Next Xbm
MoveAM DstA:=AdresseMap, Source:=TbOct(1), L:=UBound(TbOct)
On Error Resume Next
SavePicture Img.Picture, ChNomF
If Err Then
   AbandonTâche "écriture impossible"
   MsgBox "La méthode SavePicture plante :" & vbLf & Err.Description, vbExclamation, NomTâche
   FichierProduitParAPI = False
Else
   FichierProduitParAPI = True: End If
End Function
'

Sub ÉcrireFichierBMP()
Tâche "Production de l'image (plan B)", XbmMax * YbmMax
If UCase(Right(ChNomF, 4)) <> ".BMP" Then
   Dim Va As Variant
   Va = Application.GetSaveAsFilename(Left$(ChNomF, InStrRev(ChNomF, ".") - 1), "BitMaps,*.bmp", Title:=NomTâche)
   If Va = False Then AbandonTâche "réf. fichier non fournie": Succès = False: Exit Sub
   ChNomF = Va
   Range("RéfFicSor").Value = Replace(ChNomF, "\", vbLf, InStrRev(ChNomF, "\"), 1): End If
Open ChNomF For Binary Access Write As #1 Len = 1
Const BM As String * 2 = "BM": Put #1, 1, BM
BitPx = 24: NbCoul = 0
LgL = 4 * ((XbmMax * BitPx + 31) \ 32): LgM = LgL * YbmMax
LgE = 4 * NbCoul + 54: LgF = LgE + LgM
Put #1, 3, LgF: Put #1, 7, 0&: Put #1, 11, LgE: Put #1, 15, 40&
Put #1, 19, XbmMax: Put #1, 23, YbmMax
Put #1, 27, 1: Put #1, 29, BitPx: Put #1, 31, 0&
Put #1, 35, LgM: Put #1, 39, 0&: Put #1, 43, 0&: Put #1, 47, NbCoul: Put #1, 51, 0&
Dim XRempliss As Integer: XRempliss = LgL - 3 * XbmMax
For Ybm = 1 To YbmMax
   Seek #1, LgE + LgL * (YbmMax - Ybm) + 1
   For Xbm = 1 To XbmMax
      Enrg = TE(Xbm, Ybm): Chal = TH(Xbm, Ybm): Gaît = TJ(Xbm, Ybm)
      Call CalcÉngEHJ: CalcRVBÉLi
      Put #1, , CByte(Int(Bleu + 0.5))
      Put #1, , CByte(Int(Vert + 0.5))
      Put #1, , CByte(Int(Roug + 0.5))
      Call OùÇaEnEst: Next Xbm
   Oct = 0: For Xbm = 1 To XRempliss: Put #1, , Oct: Next Xbm
   Next Ybm
Close #1
Succès = True
End Sub
Sub ÉcrireCanAlpha()
   Const BM As String * 2 = "BM": Dim Alpha As Byte
   Open "C:\Users\Luck\Pictures\CanAlpha.bmp" For Binary Access Write As #1 Len = 1
   Put #1, 1, BM
   BitPx = 24: NbCoul = 0
   LgL = 4 * ((XbmMax * BitPx + 31) \ 32): LgM = LgL * YbmMax
   LgE = 4 * NbCoul + 54: LgF = LgE + LgM
   Put #1, 3, LgF: Put #1, 7, 0&: Put #1, 11, LgE: Put #1, 15, 40&
   Put #1, 19, XbmMax: Put #1, 23, YbmMax
   Put #1, 27, 1: Put #1, 29, BitPx: Put #1, 31, 0&
   Put #1, 35, LgM: Put #1, 39, 0&: Put #1, 43, 0&: Put #1, 47, NbCoul: Put #1, 51, 0&
   Dim XRempliss As Integer: XRempliss = LgL - 3 * XbmMax
   For Ybm = 1 To YbmMax
      Seek #1, LgE + LgL * (YbmMax - Ybm) + 1
      For Xbm = 1 To XbmMax
         Alpha = CByte(Int(255 * TA(Xbm, Ybm) + 0.5))
         Put #1, , Alpha: Put #1, , Alpha: Put #1, , Alpha
         Next Xbm
      Oct = 0: For Xbm = 1 To XRempliss: Put #1, , Oct: Next Xbm
      Next Ybm
   Close #1
   Shell "C:\Users\Luck\PhotoFiltre7\PhotoFiltre7 ""C:\Users\Luck\Pictures\CanAlpha.bmp""", vbNormalNoFocus
   End Sub
'

Function ImageChargéeParAPI(Img As Image) As Boolean
Dim BmAPI As BITMAP, AdresseMap As Long, TbOct() As Byte, Planes As Integer
Dim hDC As Long, NbCoul As Integer, Pal(0 To 255) As RGBQUAD, hObjectOld As Long, N°Coul As Integer, C As Long
Outils.Tâche "Chargement de l'image (plan A)", XbmMax * YbmMax
hDC = GetObjectType(Img.Picture)
If hDC <> 7 Then
   AbandonTâche "Type d'image non supporté"
   MsgBox "L'objet de type " & Array("nul", "PEN", "BRUSH", "DC", "METADC", "PAL", "FONT", "BITMAP", "REGION", _
      "METAFILE", "MEMDC", "EXTPEN", "ENHMETADC", "ENHMETAFILE", "COLORSPACE")(hDC) & " ne peut être traité.", _
   vbExclamation, NomTâche
   ImageChargéeParAPI = False: Exit Function: End If
If GetObject(Img.Picture, Len(BmAPI), BmAPI) = 0 Then
   AbandonTâche "Impossible d'analyser cette image"
   MsgBox "Impossible d'analyser cette image", vbExclamation, NomTâche
   ImageChargéeParAPI = False: Exit Function: End If
With BmAPI
   XbmMax = .bmWidth: YbmMax = .bmHeight: LgL = .bmWidthBytes
   Planes = .bmPlanes: BitPx = .bmBitsPixel: AdresseMap = .bmBits: End With
NbPixÀFaire = XbmMax * YbmMax
ReDim PxBrut(1 To 3, 1 To XbmMax, 1 To YbmMax) As Byte
ReDim TbOct(1 To LgL * YbmMax) As Byte
MoveMA TbOct(1), SrcA:=AdresseMap, L:=UBound(TbOct)
If BitPx = 24 Then
   For Xbm = 1 To XbmMax: For Ybm = 1 To YbmMax
      For C = 1 To 3: PxBrut(C, Xbm, Ybm) = TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + C): Next C
      Outils.OùÇaEnEst: Next Ybm: Next Xbm
   ImageChargéeParAPI = True
ElseIf BitPx = 8 Or BitPx = 4 Then
   hDC = CreateCompatibleDC(0)
   hObjectOld = SelectObject(hDC, Img.Picture)
   If GetDIBColorTable(hDC, 0, 256, Pal(0)) = 0 Then
      AbandonTâche "Palette de couleur inaccessible"
      MsgBox "Palette de couleur inaccessible cette image " & BitPx & " bits / pixel, vbExclamation, NomTâche"
      ImageChargéeParAPI = False: Exit Function: End If
   For Xbm = 1 To XbmMax: For Ybm = 1 To YbmMax
      If BitPx = 8 Then
         N°Coul = TbOct(Xbm + LgL * (YbmMax - Ybm))
      Else
         N°Coul = TbOct((Xbm + 1) \ 2 + LgL * (YbmMax - Ybm))
         If Xbm And &H1 Then N°Coul = N°Coul \ 16 Else N°Coul = N°Coul And &HF
         End If
      With Pal(N°Coul)
         PxBrut(1, Xbm, Ybm) = .rgbBlue
         PxBrut(2, Xbm, Ybm) = .rgbGreen
         PxBrut(3, Xbm, Ybm) = .rgbRed: End With
      Outils.OùÇaEnEst: Next Ybm: Next Xbm
   SelectObject hDC, hObjectOld 'Obligatoire parce que c'est comme ça.
   DeleteDC hDC
   ImageChargéeParAPI = True
Else
   MsgBox "Image " & BitPx & " bits / pixel non supportée", vbExclamation, NomTâche
   ImageChargéeParAPI = False: End If
End Function
'
Sub MàJImage(ByVal Img As MSForms.Image)
Dim Ech As Double, Forme As Shape
Img.Picture = LoadPicture(ChNomF)
Set Forme = Img.Parent.Shapes("Img")
On Error Resume Next
Ech = Img.Parent.[EchMinia].Value * 3 / 4
If Err Then Exit Sub
'Forme.Width = XbmMax * Ech
'Forme.Height = YbmMax * Ech
Img.Width = XbmMax * Ech
Img.Height = YbmMax * Ech
End Sub

Sub ShellPhotoEd()
ChNomF = Replace(Range("RéfFicSor").Value, vbLf, "\")
'Shell "C:\Program Files\Fichiers communs\Microsoft Shared\PhotoEd\PHOTOED.EXE """ & ChNomF & """", vbNormalNoFocus
'Shell "C:\Windows\System32\mspaint.exe """ & ChNomF & """", vbNormalNoFocus
Shell "C:\Program Files\paint.net\PaintDotNet.exe """ & ChNomF & """", vbNormalNoFocus
End Sub
Sub ShellPhotoFiltre()
ChNomF = Replace(Range("RéfFicSor").Value, vbLf, "\")
Shell "C:\Users\Luck\PhotoFiltre7\PhotoFiltre7 """ & ChNomF & """", vbNormalNoFocus
End Sub
C'est surtout la Sub ÉcrireFichierBMP() qui est intéressante. Elle part de 3 tableaux As double TE, TH, et TJ, aux dimensions de l'image à partir desquel sont calculés des codes de couleurs selon les mêmes calculs que ceux effectués dans mon CouleurCls.xlsm (disponible en téléchargement).
 
Dernière édition:
Staple1600

Staple1600

XLDnaute Barbatruc
Re

@Dranreb
Merci pour ce partage.
J'ai commencé à lire ton code VBA.
(Et en premier j'ai modifié les déclarations car je suis en 64 bits)
Mais en l'état, je ne peux tester plus avant.
 
Dranreb

Dranreb

XLDnaute Barbatruc
Les API ne sont pas nécessaires à la Sub ÉcrireFichierBMP
Elles sont plutôt utilisées pour réécrire plus rapidement le .bmp à partir de la Picture d'un ActiveX Image.
La Sub ÉcrireCanAlpha() est peut être une base plus simple pour commencer. Comme son nom l'indique elle me sert à fabriquer un fichier bmp en nuance de gris que je fait ensuite prendre en compte par PhotoFiltre comme couche de transparence.
 
Staple1600

Staple1600

XLDnaute Barbatruc
Re

J'ai une erreur ici quand je lance EcrireFichierBMP
VBE stoppe sur cette procédure
Sub ÉcritureImage(ByVal Img As Image)
et affiche ce message
Type défini par l'utilisateur non défini
 
Staple1600

Staple1600

XLDnaute Barbatruc
@Dranreb

J'ai téléchargé CouleurCls.xlsm.
Il fonctionne sur mon Office 365

Mais je n'arrive toujours pas à tester le VBA du message#92

Voici comment j'ai modifié les déclarations pour le 64 bits
Code: 
Option Explicit
Rem. Conventions API (Application Programming Interface)
Type BITMAP
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type
Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetObjectType Lib "gdi32.dll" (ByVal hgdiobj As Long) As Long
Private Declare PtrSafe Function GetObject Lib "gdi32.dll" Alias "GetObjectA" _
   (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32.dll" _
   (ByVal hDC As Long) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare PtrSafe Function GetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pRGBQuad As RGBQUAD) As Long
Private Declare PtrSafe Function SetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pcRGBQuad As RGBQUAD) As Long

Private Declare PtrSafe Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long
  
Declare PtrSafe Sub MoveMM Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal L As Long)
Declare PtrSafe Sub MoveAM Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, Source As Any, ByVal L As Long)
Declare PtrSafe Sub MoveMA Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, ByVal SrcA As Long, ByVal L As Long)
Declare PtrSafe Sub MoveAA Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, ByVal SrcA As Long, ByVal L As Long)
#Else
Private Declare Function GetObjectType Lib "gdi32.dll" (ByVal hgdiobj As Long) As Long
Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" _
   (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" _
   (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pRGBQuad As RGBQUAD) As Long
Private Declare Function SetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pcRGBQuad As RGBQUAD) As Long

Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
  
Declare Sub MoveMM Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal L As Long)
Declare Sub MoveAM Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, Source As Any, ByVal L As Long)
Declare Sub MoveMA Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, ByVal SrcA As Long, ByVal L As Long)
Declare Sub MoveAA Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, ByVal SrcA As Long, ByVal L As Long)
#End If
Dim ChNomF As String, LgL As Long, NbCoul As Long, LgE As Long, LgM As Long, LgF As Long
Dim Oct As Byte, BitPx As Integer, Succès As Boolean, Feui As Worksheet
'
Public XbmMax As Long, Xbm As Long
Public YbmMax As Long, Ybm As Long
Public TE() As Double, TH() As Double, TJ() As Double, TA() As Double
 
garnote

garnote

XLDnaute Junior
Dranreb à dit:
Bonjour.
Une de mes vieilles images :
Regarde la pièce jointe 1151106
C'est au départ un .bmp réalisé par un classeur Excel disposant d'une routine permettant d'en écrire à partir de tableaux, avec ou sans palette (au cas où ça vous intéresserait de savoir y colorer des pixels plutôt que des cellules d'une feuille de calcul).
Cliquez pour agrandir...

Staple1600 à dit:
Bonsoir le fil, @garnote, @TooFatBoy

Je ne m'en lasse pas ;)
Maintenant comme faire ceci avec la méthode de @garnote, là je sèche dans les grandes largeurs.
Code: 
Sub lime()
Application.ScreenUpdating = False
Grille
Mandelbrot
ActiveWindow.Zoom = 35
Application.ScreenUpdating = True
End Sub
Private Sub Grille()
Range("A1:OF396").ColumnWidth = 0.2
Range("A1:OF396").RowHeight = 2
End Sub
Private Sub Mandelbrot()
D = 99
For x = 1 To 4 * D
For y = 1 To 4 * D
p = 0: q = 0
For j = 1 To 98
c = 2 * p * q
p = p ^ 2 - q ^ 2 - 2 + (x - 1) / D
q = c + 2 + (1 - y) / D
If p ^ 2 + q ^ 2 >= 4 Then Exit For
Next j
j = -j * (j < D)
Cells(y, x).Interior.Color = Rnd(-j) * 1000000# * j / D
Next y, x
'crédits: Engine Toaster - septembre 2017
End Sub

Vous reprendrez bien un petit peu de PowerShell ? ;)
Code: 
$M='System.Windows.Forms';nal n New-Object;Add-Type -A System.Drawing,$M;($a=n "$M.Form").backgroundimage=($b=n Drawing.Bitmap 300,300);0..299|%{$r=$_;0..299|%{$i=99;$k=$C=n numerics.complex($_/75-2),($r/75-2);while((($k=$k*$k).Magnitude-lt4)-and$i--){$k+=$C}$b.SetPixel($_,$r,-5e6*++$i)}};$a.Show()
Il ouvre PowerShell (en mode Console)
Il copie/colle la ligne de code ci-dessus
Il fait infuser son thé 61 secondes puis il regarde son écran
Etonnant, non ?
NB: C'est aussi une spéciale dédicace à Monsieur @TooFatBoy ;)
Cliquez pour agrandir...

Staple1600 à dit:
Bonsoir le fil, @garnote, @TooFatBoy

Je ne m'en lasse pas ;)
Maintenant comme faire ceci avec la méthode de @garnote, là je sèche dans les grandes largeurs.
Code: 
Sub lime()
Application.ScreenUpdating = False
Grille
Mandelbrot
ActiveWindow.Zoom = 35
Application.ScreenUpdating = True
End Sub
Private Sub Grille()
Range("A1:OF396").ColumnWidth = 0.2
Range("A1:OF396").RowHeight = 2
End Sub
Private Sub Mandelbrot()
D = 99
For x = 1 To 4 * D
For y = 1 To 4 * D
p = 0: q = 0
For j = 1 To 98
c = 2 * p * q
p = p ^ 2 - q ^ 2 - 2 + (x - 1) / D
q = c + 2 + (1 - y) / D
If p ^ 2 + q ^ 2 >= 4 Then Exit For
Next j
j = -j * (j < D)
Cells(y, x).Interior.Color = Rnd(-j) * 1000000# * j / D
Next y, x
'crédits: Engine Toaster - septembre 2017
End Sub

Vous reprendrez bien un petit peu de PowerShell ? ;)
Code: 
$M='System.Windows.Forms';nal n New-Object;Add-Type -A System.Drawing,$M;($a=n "$M.Form").backgroundimage=($b=n Drawing.Bitmap 300,300);0..299|%{$r=$_;0..299|%{$i=99;$k=$C=n numerics.complex($_/75-2),($r/75-2);while((($k=$k*$k).Magnitude-lt4)-and$i--){$k+=$C}$b.SetPixel($_,$r,-5e6*++$i)}};$a.Show()
Il ouvre PowerShell (en mode Console)
Il copie/colle la ligne de code ci-dessus
Il fait infuser son thé 61 secondes puis il regarde son écran
Etonnant, non ?
NB: C'est aussi une spéciale dédicace à Monsieur @TooFatBoy ;)
Cliquez pour agrandir...
Ave fil, @Staple1600 @TooFatBoy
Je ne crois pas qu'on puisse faire un Mandelbrot et des Julia avec ma méthode des "456 fractales". Et quant à en faire avec des cellules plutôt qu'avec un graphique, je suis dans l'étonnement total. 😲
 
garnote

garnote

XLDnaute Junior
Dranreb à dit:
Bon, je cite provisoirement un bout de module qui fabrique des .bmp :
VB: 
Option Explicit
Rem. Conventions API (Application Programming Interface)
Type BITMAP
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type
Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type
Private Declare Function GetObjectType Lib "gdi32.dll" (ByVal hgdiobj As Long) As Long
Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" _
   (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" _
   (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pRGBQuad As RGBQUAD) As Long
Private Declare Function SetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pcRGBQuad As RGBQUAD) As Long

Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
 
Declare Sub MoveMM Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal L As Long)
Declare Sub MoveAM Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, Source As Any, ByVal L As Long)
Declare Sub MoveMA Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, ByVal SrcA As Long, ByVal L As Long)
Declare Sub MoveAA Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal DstA As Long, ByVal SrcA As Long, ByVal L As Long)

Dim ChNomF As String, LgL As Long, NbCoul As Long, LgE As Long, LgM As Long, LgF As Long
Dim Oct As Byte, BitPx As Integer, Succès As Boolean, Feui As Worksheet
'
Public XbmMax As Long, Xbm As Long
Public YbmMax As Long, Ybm As Long
Public TE() As Double, TH() As Double, TJ() As Double, TA() As Double
Sub InitCalculImage(Feuille As Worksheet)
Set Feui = Feuille
ChNomF = Replace(Range("RéfFicSor").Value, vbLf, "\")
XbmMax = Feui.Range("XbmMax").Value
YbmMax = Feui.Range("YbmMax").Value
Tâche "Calcul image", XbmMax * YbmMax
ReDim TE(1 To XbmMax, 1 To YbmMax) As Double
ReDim TH(1 To XbmMax, 1 To YbmMax) As Double
ReDim TJ(1 To XbmMax, 1 To YbmMax) As Double
ReDim TA(1 To XbmMax, 1 To YbmMax) As Double
End Sub
'

Sub ÉcritureImage(ByVal Img As Image)
Succès = FichierProduitParAPI(Img)
If Not Succès Then ÉcrireFichierBMP
If Succès Then
   MàJImage Img
   On Error Resume Next
   Dim G As Chart: Set G = Feui.ChartObjects("GImage").Chart: If Err Then Exit Sub
   G.Axes(xlCategory).MaximumScale = XbmMax
   G.Axes(xlValue).MaximumScale = YbmMax
   G.Axes(xlCategory).TickLabels.AutoScaleFont = False
   G.Axes(xlValue).TickLabels.AutoScaleFont = False
   Dim Divi As Long: On Error Resume Next: Divi = ActiveSheet.[DivGraph].Value: If Err Then Divi = 1
   On Error GoTo 0
   G.Axes(xlCategory).MajorUnit = Divi
   G.Axes(xlValue).MajorUnit = Divi
   G.PlotArea.Fill.UserPicture PictureFile:=ChNomF
   G.CopyPicture
   GphIsoEchelles G
   End If
End Sub
'

Function FichierProduitParAPI(Img As Image) As Boolean
Dim BmAPI As BITMAP, AdresseMap As Long, TbOct() As Byte
Tâche "Production de l'image (plan A)", XbmMax * YbmMax
On Error Resume Next
Img.Picture = LoadPicture(ChNomF)
If Err Then
    AbandonTâche "nouveau fichier": FichierProduitParAPI = False: Exit Function: End If
On Error GoTo 0
If GetObject(Img.Picture, Len(BmAPI), BmAPI) = 0 Then
    AbandonTâche "objet non obtenu": FichierProduitParAPI = False: Exit Function: End If
With BmAPI
   If .bmWidth <> XbmMax Or .bmHeight <> YbmMax Or .bmBitsPixel <> 24 Then
      AbandonTâche "caractéristiques image trop différentes"
      FichierProduitParAPI = False: Exit Function: End If
   LgL = .bmWidthBytes: AdresseMap = .bmBits: End With
ReDim TbOct(1 To LgL * YbmMax) As Byte
For Xbm = 1 To XbmMax: For Ybm = 1 To YbmMax
   Enrg = TE(Xbm, Ybm): Chal = TH(Xbm, Ybm): Gaît = TJ(Xbm, Ybm)
   Call CalcÉngEHJ: CalcRVBÉLi
   TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + 1) = Round(Bleu)
   TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + 2) = Round(Vert)
   TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + 3) = Round(Roug)
   Call OùÇaEnEst: Next Ybm: Next Xbm
MoveAM DstA:=AdresseMap, Source:=TbOct(1), L:=UBound(TbOct)
On Error Resume Next
SavePicture Img.Picture, ChNomF
If Err Then
   AbandonTâche "écriture impossible"
   MsgBox "La méthode SavePicture plante :" & vbLf & Err.Description, vbExclamation, NomTâche
   FichierProduitParAPI = False
Else
   FichierProduitParAPI = True: End If
End Function
'

Sub ÉcrireFichierBMP()
Tâche "Production de l'image (plan B)", XbmMax * YbmMax
If UCase(Right(ChNomF, 4)) <> ".BMP" Then
   Dim Va As Variant
   Va = Application.GetSaveAsFilename(Left$(ChNomF, InStrRev(ChNomF, ".") - 1), "BitMaps,*.bmp", Title:=NomTâche)
   If Va = False Then AbandonTâche "réf. fichier non fournie": Succès = False: Exit Sub
   ChNomF = Va
   Range("RéfFicSor").Value = Replace(ChNomF, "\", vbLf, InStrRev(ChNomF, "\"), 1): End If
Open ChNomF For Binary Access Write As #1 Len = 1
Const BM As String * 2 = "BM": Put #1, 1, BM
BitPx = 24: NbCoul = 0
LgL = 4 * ((XbmMax * BitPx + 31) \ 32): LgM = LgL * YbmMax
LgE = 4 * NbCoul + 54: LgF = LgE + LgM
Put #1, 3, LgF: Put #1, 7, 0&: Put #1, 11, LgE: Put #1, 15, 40&
Put #1, 19, XbmMax: Put #1, 23, YbmMax
Put #1, 27, 1: Put #1, 29, BitPx: Put #1, 31, 0&
Put #1, 35, LgM: Put #1, 39, 0&: Put #1, 43, 0&: Put #1, 47, NbCoul: Put #1, 51, 0&
Dim XRempliss As Integer: XRempliss = LgL - 3 * XbmMax
For Ybm = 1 To YbmMax
   Seek #1, LgE + LgL * (YbmMax - Ybm) + 1
   For Xbm = 1 To XbmMax
      Enrg = TE(Xbm, Ybm): Chal = TH(Xbm, Ybm): Gaît = TJ(Xbm, Ybm)
      Call CalcÉngEHJ: CalcRVBÉLi
      Put #1, , CByte(Int(Bleu + 0.5))
      Put #1, , CByte(Int(Vert + 0.5))
      Put #1, , CByte(Int(Roug + 0.5))
      Call OùÇaEnEst: Next Xbm
   Oct = 0: For Xbm = 1 To XRempliss: Put #1, , Oct: Next Xbm
   Next Ybm
Close #1
Succès = True
End Sub
Sub ÉcrireCanAlpha()
   Const BM As String * 2 = "BM": Dim Alpha As Byte
   Open "C:\Users\Luck\Pictures\CanAlpha.bmp" For Binary Access Write As #1 Len = 1
   Put #1, 1, BM
   BitPx = 24: NbCoul = 0
   LgL = 4 * ((XbmMax * BitPx + 31) \ 32): LgM = LgL * YbmMax
   LgE = 4 * NbCoul + 54: LgF = LgE + LgM
   Put #1, 3, LgF: Put #1, 7, 0&: Put #1, 11, LgE: Put #1, 15, 40&
   Put #1, 19, XbmMax: Put #1, 23, YbmMax
   Put #1, 27, 1: Put #1, 29, BitPx: Put #1, 31, 0&
   Put #1, 35, LgM: Put #1, 39, 0&: Put #1, 43, 0&: Put #1, 47, NbCoul: Put #1, 51, 0&
   Dim XRempliss As Integer: XRempliss = LgL - 3 * XbmMax
   For Ybm = 1 To YbmMax
      Seek #1, LgE + LgL * (YbmMax - Ybm) + 1
      For Xbm = 1 To XbmMax
         Alpha = CByte(Int(255 * TA(Xbm, Ybm) + 0.5))
         Put #1, , Alpha: Put #1, , Alpha: Put #1, , Alpha
         Next Xbm
      Oct = 0: For Xbm = 1 To XRempliss: Put #1, , Oct: Next Xbm
      Next Ybm
   Close #1
   Shell "C:\Users\Luck\PhotoFiltre7\PhotoFiltre7 ""C:\Users\Luck\Pictures\CanAlpha.bmp""", vbNormalNoFocus
   End Sub
'

Function ImageChargéeParAPI(Img As Image) As Boolean
Dim BmAPI As BITMAP, AdresseMap As Long, TbOct() As Byte, Planes As Integer
Dim hDC As Long, NbCoul As Integer, Pal(0 To 255) As RGBQUAD, hObjectOld As Long, N°Coul As Integer, C As Long
Outils.Tâche "Chargement de l'image (plan A)", XbmMax * YbmMax
hDC = GetObjectType(Img.Picture)
If hDC <> 7 Then
   AbandonTâche "Type d'image non supporté"
   MsgBox "L'objet de type " & Array("nul", "PEN", "BRUSH", "DC", "METADC", "PAL", "FONT", "BITMAP", "REGION", _
      "METAFILE", "MEMDC", "EXTPEN", "ENHMETADC", "ENHMETAFILE", "COLORSPACE")(hDC) & " ne peut être traité.", _
   vbExclamation, NomTâche
   ImageChargéeParAPI = False: Exit Function: End If
If GetObject(Img.Picture, Len(BmAPI), BmAPI) = 0 Then
   AbandonTâche "Impossible d'analyser cette image"
   MsgBox "Impossible d'analyser cette image", vbExclamation, NomTâche
   ImageChargéeParAPI = False: Exit Function: End If
With BmAPI
   XbmMax = .bmWidth: YbmMax = .bmHeight: LgL = .bmWidthBytes
   Planes = .bmPlanes: BitPx = .bmBitsPixel: AdresseMap = .bmBits: End With
NbPixÀFaire = XbmMax * YbmMax
ReDim PxBrut(1 To 3, 1 To XbmMax, 1 To YbmMax) As Byte
ReDim TbOct(1 To LgL * YbmMax) As Byte
MoveMA TbOct(1), SrcA:=AdresseMap, L:=UBound(TbOct)
If BitPx = 24 Then
   For Xbm = 1 To XbmMax: For Ybm = 1 To YbmMax
      For C = 1 To 3: PxBrut(C, Xbm, Ybm) = TbOct(3 * (Xbm - 1) + LgL * (YbmMax - Ybm) + C): Next C
      Outils.OùÇaEnEst: Next Ybm: Next Xbm
   ImageChargéeParAPI = True
ElseIf BitPx = 8 Or BitPx = 4 Then
   hDC = CreateCompatibleDC(0)
   hObjectOld = SelectObject(hDC, Img.Picture)
   If GetDIBColorTable(hDC, 0, 256, Pal(0)) = 0 Then
      AbandonTâche "Palette de couleur inaccessible"
      MsgBox "Palette de couleur inaccessible cette image " & BitPx & " bits / pixel, vbExclamation, NomTâche"
      ImageChargéeParAPI = False: Exit Function: End If
   For Xbm = 1 To XbmMax: For Ybm = 1 To YbmMax
      If BitPx = 8 Then
         N°Coul = TbOct(Xbm + LgL * (YbmMax - Ybm))
      Else
         N°Coul = TbOct((Xbm + 1) \ 2 + LgL * (YbmMax - Ybm))
         If Xbm And &H1 Then N°Coul = N°Coul \ 16 Else N°Coul = N°Coul And &HF
         End If
      With Pal(N°Coul)
         PxBrut(1, Xbm, Ybm) = .rgbBlue
         PxBrut(2, Xbm, Ybm) = .rgbGreen
         PxBrut(3, Xbm, Ybm) = .rgbRed: End With
      Outils.OùÇaEnEst: Next Ybm: Next Xbm
   SelectObject hDC, hObjectOld 'Obligatoire parce que c'est comme ça.
   DeleteDC hDC
   ImageChargéeParAPI = True
Else
   MsgBox "Image " & BitPx & " bits / pixel non supportée", vbExclamation, NomTâche
   ImageChargéeParAPI = False: End If
End Function
'
Sub MàJImage(ByVal Img As MSForms.Image)
Dim Ech As Double, Forme As Shape
Img.Picture = LoadPicture(ChNomF)
Set Forme = Img.Parent.Shapes("Img")
On Error Resume Next
Ech = Img.Parent.[EchMinia].Value * 3 / 4
If Err Then Exit Sub
'Forme.Width = XbmMax * Ech
'Forme.Height = YbmMax * Ech
Img.Width = XbmMax * Ech
Img.Height = YbmMax * Ech
End Sub

Sub ShellPhotoEd()
ChNomF = Replace(Range("RéfFicSor").Value, vbLf, "\")
'Shell "C:\Program Files\Fichiers communs\Microsoft Shared\PhotoEd\PHOTOED.EXE """ & ChNomF & """", vbNormalNoFocus
'Shell "C:\Windows\System32\mspaint.exe """ & ChNomF & """", vbNormalNoFocus
Shell "C:\Program Files\paint.net\PaintDotNet.exe """ & ChNomF & """", vbNormalNoFocus
End Sub
Sub ShellPhotoFiltre()
ChNomF = Replace(Range("RéfFicSor").Value, vbLf, "\")
Shell "C:\Users\Luck\PhotoFiltre7\PhotoFiltre7 """ & ChNomF & """", vbNormalNoFocus
End Sub
C'est surtout la Sub ÉcrireFichierBMP() qui est intéressante. Elle part de 3 tableaux As double TE, TH, et TJ, aux dimensions de l'image à partir desquel sont calculés des codes de couleurs selon les mêmes calculs que ceux effectués dans mon CouleurCls.xlsm (disponible en téléchargement).
Cliquez pour agrandir...
Démentiel ! Nettement au-delà de mes petites compétences! 😥
 
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Staple1600 à dit:
J'ai une erreur ici quand je lance EcrireFichierBMP
…
Type défini par l'utilisateur non défini
Cliquez pour agrandir...
Insère un nouvel UserForm que tu supprimera ensuite. Il s'agit sans nul doute de MSForms.Image
Je ne peux pas joindre ce classeur, il est énorme, et en perpétuelle évolution, avec 44 feuille. Je le bricole chaque fois que je veux fabriquer une nouvelle image de bouton par exemple.
De plus il a en référence un classeur de macro lui aussi énorme.
Le mieux serait je pense que j'équipe un de vos classeur de quoi fabriquer un .bmp
Ou alors que vous me décriviez quel classeur à possibilités limitées vous intéresserait.
 
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour Dranreb

On pourrait partir sur l'exemple du message#53
(Je republie le code ici pour faciliter la facture)
VB: 
Sub Dessiner_Julia()
Application.ScreenUpdating = False
Range("C3:HL141").Interior.Color = vbBlack
Calculs
Mise_En_Forme
End Sub
Sub Calculs()
[B1] = 0.0002: [D3] = 0.2: [C4] = 0.3
[E3:HK3].Formula = "=D3+$B$1": [C5:C140].Formula = "=C4-$B$1": [D4:HK140].Formula = "=JULIA(D$3,$C4)"
[C5].CurrentRegion = [C5].CurrentRegion.Value
End Sub

Sub Mise_En_Forme()
Dim Julia As Range
Set Julia = Range("D4:HK140")
Julia.ColumnWidth = 0.35: Julia.RowHeight = 3.5
Julia.FormatConditions.AddColorScale ColorScaleType:=3
Julia.FormatConditions(Julia.FormatConditions.Count).SetFirstPriority
Julia.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
Julia.FormatConditions(1).ColorScaleCriteria(1).FormatColor.Color = vbRed
Julia.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
Julia.FormatConditions(1).ColorScaleCriteria(2).Value = 50
Julia.FormatConditions(1).ColorScaleCriteria(2).FormatColor.Color = vbYellow
Julia.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
Julia.FormatConditions(1).ColorScaleCriteria(3).FormatColor.Color = vbGreen
ActiveWindow.Zoom = 50
End Sub
Function Julia(x, y) As Integer
Dim Modulo, z_reel, z_imag, z_carre_reel, z_carre_imag As Double
Dim n As Integer
n = 0
Modulo = 0
z_reel = x
z_imag = y
Do While (n < 200 And Modulo < 2)
z_carre_reel = z_reel ^ 2 - z_imag ^ 2
z_carre_imag = 2 * z_reel * z_imag
z_reel = z_carre_reel - 0.7927
z_imag = z_carre_imag + 0.1609
Modulo = Sqr(z_reel ^ 2 + z_imag ^ 2)
n = n + 1
Loop
Julia = n
End Function
Je cherche effectivement à m'affranchir des cellules et de passer par des tableaux mais là cela dépasse mes compétences (notamment au niveau des mathématiques)

Ou alors si vous pouvez publier un extrait de votre classeur, ce serait chouette
1) Génération d'une "fractale" et une seule (Julia ou Mandelbrot)
2) Export en fichier *.BMP
 
Dranreb

Dranreb

XLDnaute Barbatruc
Pourrais-je avoir un classeur, que je puisse voir où on saisit l'échelle, les dimensions de l'image, le centre (si décentré) et les parties réelle et imaginaire du complexe caractéristique de l'ensemble voulu ?
Un bmp à palette serait-il souhaité ?
 
Staple1600

Staple1600

XLDnaute Barbatruc
Re

@Dranreb
Le code VBA ne suffit-il pas ?
(en tout cas pour l'exemple que j'ai posté dans ce fil)
Je remets le code VBA sans utiliser les balises SPOILER
Il suffit de copier/coller tout le code VBA dans un classeur vierge
et de lancer la macro Dessiner_Julia
En B1, se trouve le pas pour calculer les valeurs de la partie réelle de z0 en [E3:HK3] et en [C5:C140] les valeurs de la partie imaginaire.
VB: 
Sub Dessiner_Julia()
Application.ScreenUpdating = False
Range("C3:HL141").Interior.Color = vbBlack
Calculs
Mise_En_Forme
End Sub
Sub Calculs()
[B1] = 0.0002: [D3] = 0.2: [C4] = 0.3
[E3:HK3].Formula = "=D3+$B$1": [C5:C140].Formula = "=C4-$B$1": [D4:HK140].Formula = "=JULIA(D$3,$C4)"
[C5].CurrentRegion = [C5].CurrentRegion.Value
End Sub

Sub Mise_En_Forme()
Dim Julia As Range
Set Julia = Range("D4:HK140")
Julia.ColumnWidth = 0.35: Julia.RowHeight = 3.5
Julia.FormatConditions.AddColorScale ColorScaleType:=3
Julia.FormatConditions(Julia.FormatConditions.Count).SetFirstPriority
Julia.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
Julia.FormatConditions(1).ColorScaleCriteria(1).FormatColor.Color = vbRed
Julia.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
Julia.FormatConditions(1).ColorScaleCriteria(2).Value = 50
Julia.FormatConditions(1).ColorScaleCriteria(2).FormatColor.Color = vbYellow
Julia.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
Julia.FormatConditions(1).ColorScaleCriteria(3).FormatColor.Color = vbGreen
ActiveWindow.Zoom = 50
End Sub
Function Julia(x, y) As Integer
Dim Modulo, z_reel, z_imag, z_carre_reel, z_carre_imag As Double
Dim n As Integer
n = 0
Modulo = 0
z_reel = x
z_imag = y
Do While (n < 200 And Modulo < 2)
z_carre_reel = z_reel ^ 2 - z_imag ^ 2
z_carre_imag = 2 * z_reel * z_imag
z_reel = z_carre_reel - 0.7927
z_imag = z_carre_imag + 0.1609
Modulo = Sqr(z_reel ^ 2 + z_imag ^ 2)
n = n + 1
Loop
Julia = n
End Function
Un bmp à palette serait-il souhaité ?
Cliquez pour agrandir...
Je réponds oui (sans forcément savoir ce qu'est un bmp à palette)

Il faut que je retourne consulter votre outil CouleurCls pour me rafraichir la mémoire.
 
Dranreb

Dranreb

XLDnaute Barbatruc
Un bmp à palette est à 256 valeurs différentes par pixel (1 octet donc par pixel) correspondant à des codes couleurs indiqués dans une table au début. c'est cette table qui constitue la palette.
 
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Précisions
Je parcoure beaucoup de sites relatifs aux fractales, à Mandelbrot etc..
Mais mes lacunes en mathématiques et en programmation m'empêchent d'utiliser les outils plus adaptés qu'Excel.

Donc pour le moment, je me contente de tester ou reproduire ce que je comprends en VBA dans Excel.
 

Membres actuellement en ligne

23 membres et 350 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 308
Messages
2 087 104
Membres
103 469
dernier inscrit
Thibz