ScaleFactorX = Image1.Width / ScaleX(Image1.Picture.Width, _ > vbHimetric, vbTwips) > ScaleFactorY = Image1.Width / ScaleY(Image1.Picture.Width, _ > vbHimetric, vbTwips)[/color] * 'Nom: TransPic * 'Création: Samuel Hanoteau, Gradué (6/09/2000) * 'Modification: Samuel Hanoteau, Gradué (11/09/2000) * 'Arguments: Image (PictureBox à éditer) * ' Couleur (couleur à rendre transparente) * 'Description: rend une des couleurs de la PictureBox transparente. La couleur par défaut est vbWhite mais le développeur peut choisir de définir cette culeur. * * Option Explicit * * Public Sub TransPic(Image As PictureBox, Optional Couleur As ColorConstants = vbWhite) * Dim TInt1 As Integer * Dim TInt2 As Integer * Dim SaveScale As Integer * SaveScale = Image.ScaleMode * Image.ScaleMode = 3 * For TInt1 = 0 To (Image.ScaleWidth - 1) * For TInt2 = 0 To (Image.ScaleHeight - 1) * If (Image.Point(TInt1, TInt2) = Couleur) Then * Image.PSet (TInt1, TInt2), Image.ForeColor * End If * Next * Next * Image.ScaleMode = SaveScale * End Sub * If Clipboard.GetFormat(vbCFBitmap) Then Call SavePicture(Clipboard.GetData(vbCFBitmap), App.Path & "\test.bmp") End If * Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject") * Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel * StrPath = "C:\Donnees\Rapport\" 'Chemin d'accès du fichier * If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\" 'Ajoute \ à la fin s'il y en a pas * StrFich = "Igli07_aout.txt" 'Nom du fichier * If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier * waExcel.Visible = False 'Rendre invisible Excel * 'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space * waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, , , True * 'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs * waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich, Len(StrFich) - 4) & ".xls", , , , , , 2 * End If * 'Fermeture d'Excel * waExcel.Application.Quit ///////////////////////////////////////////////////// Pour cela il faut d'abord ajouter dans les références (Projet --> Références) "Microsoft Excel 10.0 Object Library" * Dim xls As Excel.Workbook ' déclaration d'une variable objet de type classeur Excel * Dim var As ce_que_vous_voulez * * Set xls = GetObject("monfichier.xls") 'instanciation de l'objet (qui devient ici le fichier excel indiqué) * * ' export de données * With xls * .worksheets(1).range("B6").Value = "1" * .worksheets(1).range("B18").Value = "2" * .worksheets(1).range("A18").Value = "3" * End With * * ' worksheets(1) correspond à la feuille 1 du fichier Excel * ' pour spécifier le nom d'une feuille mettre à la place sheets("nom de la feuille") * * ' import de données * var = xls.worksheets(1).range("C2").Value * * ' etc etc... * ' après à vous d'adapter le code en fonction de vos besoin * * ' une fois que vous avez fini d'utiliser la variable xls, pensez à la détruire * Set xls = Nothing * * ' PS: le code ci-dessus utilise un fichier Excel déjà existant. * ' Pour créer un fichier Excel à partir d'une appli VB voici la manip: * * Dim xls as Excel.Application * Set xls = CreateObject("Excel.Application") ' création d'une nouvelle instance vierge de l'application Excel * * ' après paramètrez le fichier comme bon vous semble. * ' Voici quelques exemples * xls.WindowState = xlMaximized ' format plein écran * xls.Visible = True ' visible à l'écran * xls.ShowWindowsInTaskbar = True ' visible dans la barre de tâches * xls.DisplayFormulaBar = True ' affichage de la barre de formule * xls.Caption = "Mon fichier Excel" * xls.Workbooks.Add ' ajout d'un classeur Excel sinon vous aurez une instance d'Excel mais pas de classeur * xls.Worksheets(1).Name = "Feuille1" * xls.Worksheets(2).Name = "Feuille2" * xls.Worksheets(1).Range("D1").Font.Bold = True ' la cellule D1 est en gras * xls.Worksheets(1).Columns("A:A").EntireColumn.AutoFit 'ajustement automatique de la colonne A * xls.Worksheets(1).PrintOut Copies:=1 ' imprimer 1 copie de la feuille 1 * * ' je vais pas tous les faire parce que les possibilitées sont énormes. * ' une bonne astuce pour voir les commandes correspondant à ce que vous * ' souhaitez faire est de créer un fichier Excel, de lancer l'enregistrement d'une macro, * ' d'exécuter les opérations voulues (changement police, ajustement colonne etc), * ' d'arrêter l'enregistrement de la macro et d'aller voir le code qui a été créé. Perso c'est * ' comme ça que j'ai procédé. //////////////////////////////////////////// * Option Explicit * * Private Sub Form_Load() * List1.AddItem "Adam" * List1.AddItem "Bernard" * List1.AddItem "Charles" * List1.AddItem "Christophe" * List1.AddItem "Edouard" * List1.AddItem "Emilie" * List1.AddItem "Fabrice" * List1.AddItem "Juliette" * End Sub * * Private Sub cmdListEXCEL_Click() * Dim Appli As New Application * Dim Ligne As String * Dim LigneExcel As Integer * Dim compt As Integer * * 'Rendre visible EXCEL * Appli.Visible = True * * 'Créer un nouveau classeur EXCEL initialisé à la ligne 1 * Appli.Workbooks.Add.Activate * LigneExcel = 1 * * 'Inscrire le contenu d'une listbox dans la feuille 1 d'un classeur EXCEL * * For compt = 0 To List1.ListCount - 1 * * ' Affecter les données de la listbox dans les cellules de la feuille * With ActiveWorkbook.Worksheets("Feuil1") * .Cells(LigneExcel, 1) = List1.List(compt) * LigneExcel = LigneExcel + 1 * End With * * Next compt * * MsgBox "Importation terminée.", vbInformation + vbOKOnly, "Fichier Texte -> Classeur EXCEL" * Unload Me * * End Sub