Recueil Codes VBA

[David Aubert]

Titre et lien de téléchargement : Recueil Codes VBA

Réalisé par : Viard Jean-Paul

Recueil de Code VBA version-10
Ce programme permet d'archiver des codes VBA.
De les organiser par thème. (Procédure, Module de classe, Fonction etc.)
Ces codes peuvent être importés (création de l'archive) ou exportés selon le besoin vers un autre Classeur, ou imprimés.
Il peut également servir de recueil de poésies ou autre.
La capacité de stockage est importante à raison de 84 thèmes d’archive pour Excel2000.
Taille d’un module 60 lignes, soit environ supérieur à 1000 modules par thème.

Manuel d’utilisation inclus dans le programme.

 

[VIARD]

Re : Recueil Codes VBA

Bonjour à tous

Mise à jour du module d'impression

'============================================
Private Sub CommandButton2_Click() 'Imprimer Module
Dim Col%, Posit%, Posit2%
Dim Début&, Fin&, Plage$
Dim P1$, P2$, P3$, P4$, P5$, P6$

Application.ScreenUpdating = False
Sheets("Feuil1").Activate
'----- Mise en place du Titre du Module ------
Col = Cells(2, 3).Value
Cells(2, Col + 1).Value = TextBox5.Value
'----------- Plage ------------
Début = Label3.Caption
Fin = Label4.Caption
'------- Extrait 1° caractère de la plage -----
P1 = Columns(Col + 1).Address
P2 = Right(P1, Len(P1) - 1)
Posit = InStr(1, P2, ":")
P3 = Left(P2, Posit - 1)
'------- Extrait 2° caractère de la plage -----
P4 = Columns(Col + 1).Address
P5 = Right(P4, Len(P1) - 1)
Posit2 = InStr(1, P5, ":")
P6 = Left(P5, Posit2 - 1)
'-------------- Plage Imprimer ----------------
Plage = P3 & Début & ":" & P6 & Fin
'-------- Impression ----------
Sheets("Feuil1").Activate
With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$3"
    .Orientation = 1
    .Zoom = 100
    .PrintArea = Plage
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1
'----- Restitution de l'intitulé ------
Cells(2, Col + 1).Value = "Macros VBA Excel"
Application.ScreenUpdating = True
Sheets("Feuil1").Select
Range("A1").Select
End Sub
'============================================

Mettre ce code en remplacement du bouton d'mpression "2".
Avec l'ancien code l'impression était limité au 26° thème.

Celui-ci permet d'aller jusqu'au bout.
Les modules à imprimer étant tous de tailles différentes.

Salutation à tous

Jean-Paul

 

[bangbang]

Re : Recueil Codes VBA

Bonjour
j'aimerais créer une fonction en vba qui prend en arguments deux vecteurs et retourne un vecteur qui est la concaténation des deux vecteurs. exemple. on a [1,2,3,4] et [5,6,7,8,9] et on veut retourner [1,2,3,4,5,6,7,8,9]. comment faire exécuter et afficher les tableaux ou vecteurs?

 

[Dranreb]

Re : Recueil Codes VBA

Bonjour Bangbang.

J'ai cette fonction qui fait pratiquement ça :

Function TableUnique(ParamArray TP() As Variant) As Variant()
Rem. —— Renvoie un tableau unique où sont empilés l'un derrière l'autre plusieurs tableaux de
'       diverses sources. La seconde dimension des différents tableaux doit commencer à 1.
'       Cependant dans le tableau résultant elle commencera à 0, l'élément 0 restituant le
'       numéro d'ordre de la source, commençant à 0 pour la 1ère.
Dim P As Long, C As Long, CMax As Long, TCbl(), Lr&, TSrc(), Le&
For P = 0 To UBound(TP)
   If TypeName(TP(P)) = "Range" Then
      Lr = Lr + TP(P).Rows.Count: C = TP(P).Columns.Count
   Else: Lr = Lr + UBound(TP(P), 1) + 1 - LBound(TP(P), 1)
      C = UBound(TP(P), 2): End If
   If C > CMax Then CMax = C
   Next P
ReDim TCbl(1 To Lr, 0 To CMax): Lr = 0
For P = 0 To UBound(TP)
   If TypeName(TP(P)) = "Range" Then TSrc = TP(P).Value Else TSrc = TP(P)
   For Le = LBound(TSrc, 1) To UBound(TSrc, 1): Lr = Lr + 1: TCbl(Lr, 0) = P
      For C = 1 To UBound(TSrc, 2): TCbl(Lr, C) = TSrc(Le, C): Next C, Le, P
TableUnique = TCbl
End Function