Conversion à partir de VBA
Bonjour à tous,
J'espère être dans la bonne partie du Forum.
J'ai retravaillé une macro excel existante pensant naïvement que je pourrais aisément la passer sur Google Sheet.
(Cela n'était pas le but principal mais souhaitant partager mon fichier et le rendre éditable en ligne, je n'ai finalement pas le choix).
Je me perds totalement dans tous les tutos de conversion.
Je me permet donc de vous mettre ma macro afin de soit être guidée ou peut-être m'apporter une solution de conversion.
Je vous remercie :
Option Explicit
Dim n As Double
Public Sub CreateWorksheet()
Dim ws As Worksheet, wsTemplate As Worksheet
Dim sheetName As String, Message As String
Dim r As Variant
n = WorksheetFunction.IsoWeekNum(DateSerial(Year(Date), 12, 28))
Message = "Entretien numéro :"
Do
r = InputBox(Message, Title:="Carnet d'entretien")
Loop While r < 1 Or r > n And r <> ""
If r <> "" Then
Application.ScreenUpdating = False
sheetName = "Entretien n°" & Format(r, "00")
On Error Resume Next
Set ws = Worksheets(sheetName)
On Error GoTo 0
If ws Is Nothing Then
Set wsTemplate = Worksheets("Modèle")
wsTemplate.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sheetName
SortWorksheets
Else
MsgBox "La feuille " & sheetName & " existe déjà !", 64, "Information"
End If
Else
MsgBox "Procédure annulée par l'utilisateur", 64, "Information"
End If
End Sub
Private Sub SortWorksheets()
Dim i As Long, j As Long
If n > 3 Then
For i = 3 To Worksheets.Count
For j = i To Worksheets.Count
If UCase(Worksheets(j).Name) < UCase(Worksheets(i).Name) Then
Worksheets(i).Move before:=Worksheets(j)
Worksheets(j).Move before:=Worksheets(i)
End If
Next j
Next i
End If
End Sub
Bonjour, et bienvenue,
Je connais bien excel et je pense sincèrement qu'il faut oublier de penser convertir :
- google sheets recèle de fonctions natives qui peuvent aisément remplacer des macros
- le langage est différent entre un script qui puise son langage dans le javascript universellement utilisé, et le VBA qui est un langage propriétaire microsoft
Il vaudrait mieux que tu mettes un lien vers un fichier exemple simplifié sous GSheets https://www.sheets-pratique.com/fr/cours/partage, et que tu fasses une courte présentation de ce que tu veux faire.
entre temps, j'ai lu ton code VBA, j'ai ceci qui reste à adapter ... (il s'agissait ici de dupliquer un template par user)
function duplicateTemplate() {
let template = SpreadsheetApp.getActive().getSheetByName('template')
let users = SpreadsheetApp.getActive().getSheetByName('users').getRange("A2:A").getDisplayValues().flat();
users.forEach(user => {
template.getRange("A1").activate()
let new = SpreadsheetApp.getActiveSpreadsheet().duplicateActiveSheet()
new.setName(user)
})
};
Bonjour,
Je te remercie pour ta réponse.
Je vais effectivement tenter de voir ce que propose directement Google Sheet.
Cela pourrait s'avérer plus simple que de m'obstiner à convertir (même si je n'y connais pas grand chose au final)
Pour suivre tes conseils, je me permet également de partager mon fichier :
Dans mon fichier, j'ai une macro qui me permet de dupliquer une feuille qui me sert de base (pas la feuille active)
La macro, en plus de dupliquer cette feuille, m'ouvre une fenêtre qui permet directement de la renommer (un message d'erreur apparaît si le nom existe déjà).
De plus la feuille de base contiendra également un bouton permet d'exporter la feuille active en pdf.
Je ne sais donc pas si tout cela est possible sous Google Sheet.
Merci
Bonjour,
ce qu'il faudrait, c'est partager ton fichier GSheets, https://www.sheets-pratique.com/fr/cours/partage
cela permet au passage d etravailler avec les mêmes paramètres régionaux et d'échanger facilement les formules
Mais ton fichier est au format excel, pas Google Sheets ... bon je fais une conversion et je regarde.
Prends une copie
https://docs.google.com/spreadsheets/d/1UlRzK_7N_9x38rlOsOHvm74Sy3DsMZqcRgdBHFfQw5w/copy
Un menu doit apparaître en haut à droite
Si ce n'est pas le cas, fais outils > éditeur de script et exécute la fonction onOpen en répondant aux demandes de sécurité d'accès
On verra la conversion en pdf dans un deuxième temps
function onOpen() {
var ui = SpreadsheetApp.getUi();
ui.createMenu('↓ Menu Tutorat ↓')
.addItem('Créer une nouvelle fiche', 'dupliquer')
.addItem('Éditer la fiche en pdf', 'creerPDF')
.addToUi();
}
function dupliquer(){
var ui = SpreadsheetApp.getUi();
var result = ui.prompt('Nom de la nouvelle fiche !','S\'il vous plaît entrez le nom :', ui.ButtonSet.OK_CANCEL);
var choix = result.getSelectedButton();
var text = result.getResponseText();
if (choix != ui.Button.OK) {
ui.alert('Abandon !');
return
}
var f = SpreadsheetApp.getActiveSpreadsheet().getSheetByName(text)
if (f != null){
ui.alert('Cette fiche existe déjà !');
return
}
else{
let template = SpreadsheetApp.getActive().getSheetByName('Modèle')
let nouvelle = SpreadsheetApp.getActiveSpreadsheet().duplicateActiveSheet()
nouvelle.setName(text)
}
}
function creerPDF(){
}
Cela correspond tout à fait.
J'aime bien l'idée d'avoir finalement un menu.
Je te remercie énormément.
Par contre, comme tu me l'as montré, si je le partage pour que d'autres l'utilisent, exécuter la fonction onOpen est indispensable (pour la 1ère utilisation) ?
Pour les pdf, où veux-tu les stocker ?
Idéalement sur le bureau avec choix du dossier. Il s'agirait d'un simple export en pdf
Bonjour,
Je ne pense pas qu'on puisse sauvegarder sur le bureau directement (sans passer par python par exemple).
Le mieux est de créer un dossier dans le drive, relever son ID (longue série de caractères entre /xxxxx/, et mettre à jour le script ci-dessous avec ce n°
Remplace le script par ceci
function onOpen() {
var ui = SpreadsheetApp.getUi();
ui.createMenu('↓ Menu Tutorat ↓')
.addItem('Créer une nouvelle fiche', 'dupliquer')
.addItem('Éditer la fiche en pdf', 'creerPDF')
.addToUi();
}
function dupliquer(){
var ui = SpreadsheetApp.getUi();
var result = ui.prompt('Nom de la nouvelle fiche !','S\'il vous plaît entrez le nom :', ui.ButtonSet.OK_CANCEL);
var choix = result.getSelectedButton();
var text = result.getResponseText();
if (choix != ui.Button.OK) {
ui.alert('Abandon !');
return
}
const doc = SpreadsheetApp.getActiveSpreadsheet();
var f = doc.getSheetByName(text)
if (f != null){
ui.alert('Cette fiche existe déjà !');
return
}
else{
doc.setActiveSheet(doc.getSheetByName('Modèle'))
let nouvelle = doc.duplicateActiveSheet()
nouvelle.setName(text)
}
}
function creerPDF(){
// Création du fichier pdf
const doc = SpreadsheetApp.getActiveSpreadsheet();
const feuille = doc.getActiveSheet();
var ui = SpreadsheetApp.getUi();
if (feuille.getName() == 'Accueil' || feuille.getName() == 'Modèle'){
ui.alert('Placez-vous sur une fiche !');
return
}
const docID = doc.getId();
const feuilleID = feuille.getSheetId();
const dossier = DriveApp.getFolderById('18akqHAN7PSxxxxxxxxxxxxxxxxxxxxxxxxxxxxxMCv4TqCM'); // mettre à jour
const d = Utilities.formatDate(new Date(), "GMT+1", "yyyy-MM-dd")
const fichier = feuille.getName() + '_' + d + ".pdf"
const url = 'https://docs.google.com/spreadsheets/d/' + docID + '/export?';
const exportOptions =
'exportFormat=pdf&format=pdf' +
'&size=A4' +
'&portrait=true' + // orientation portrait, false pour paysage
'&fitw=true' + // ajustement en largeur
'&sheetnames=false&printtitle=false' + // pas de nom ni de titre à l'impression
'&pagenumbers=false&gridlines=false' + // pas de numérotation, pas de grille
'&fzr=false' + // frozen rows = pas de répétition de l'en-tête
'&gid=' + feuilleID;
var params = {method:"GET",headers:{"authorization":"Bearer "+ ScriptApp.getOAuthToken()}};
var reponse = UrlFetchApp.fetch(url + exportOptions, params).getBlob();
// Sauvegarde du fichier.
dossier.createFile(reponse.setName(fichier));
}
Bonjour,
Je te remercie pour tout le travail que tu as fait.
Cela correspond parfaitement à ce que je souhaitais.
J'ai 2/3 point à adapter mais je devrais pouvoir m'en sortir.
Encore merci
Bonjour à toutes et à tous, chers membres du forum et contributeurs.
Je reviens vers vous suite, à une modification de mon fichier qui fonctionnait très bien jusqu'alors, et pour lequel je remercie la totalité des participants qui m'ont apportés "grand aide" dans la finalisation de ce fichier (en particulier, i20100)
Cependant, afin de répondre à un besoin d'évolution de structure du tableur, j'aurai voulu savoir si il était possible de:
1) -pouvoir sauvegarder les informations/valeurs de toutes les cellules qui étaient sélectionnées jusqu'alors sur mon ActiveSheet "Demande d'Intervention", et transférées sur l'onglet "Suivi".....si il est possible, vu que j'ai 3 sites différents à gére....que en fonction de la valeur choisie d'une cellule allouée aux sites proposée via menu déroulant, et correspondant aux 3 noms des onglets/feuilles que j'ai après mon Activesheet "DI", que seul l'onglet/feuille dédié au site choisi puisse récupérer les données en créant une ligne supplémentaire au tableau existant déjà sous cet onglet? J'ai bien essayer de faire des recherches sur le sujet, mais il est + proposé l'inverse (récup d'infos de différents onglets pour remettre sur une feuille unique) que des reculs des données et les classer en créant une nouvelle ligne uniquement sur le tableau de la feuille(onglet) concernée (en fonction du nom).
2° Petit problème pour repenser le code, si mon envoi automatique par e- mail viendrait à changer (prévu prochainement) via Gmail.
J'ai bien fouillé également, avec en codage l'utilisation de CDO, mais le souci est que je ne suis pas le seul à utiliser ce fichier...donc ça pose un souci, vu que le codage CDO demande d'intégrer les paramètres Serveur (smtp.gmail) , ainsi que fourni identifiant et code accès à ce type de messagerie.
Donc si je rentre mes informations, c'est sous ma messagerie que mails vont partir, ou alors les autres utilisateurs vont se retrouver avec un blocage à l'exception de la macro au moment de l'envoi (si connecté avec leur propre compte Gmail-Perso)
Voilà, c'est déjà 2 gros problèmes à résoudre, sachant que le + "urgent" réside dans le fait que j'ai déjà les 3 sites en gestion et que je ne peux plus faire fonctionner mon code "en l'état'. Hormis pour 1 site, pour lequel le code était totalement fonctionnel.
Encore merci à tous par avance, et pour votre bienveillance.
Voici le code qui est (était, sur nouveau fichier) fonctionnel sur la sheet (la seule/onglet unique sur fichier initial) où sont (étaient, sur nouveau fichier)reportées les infos et qui permettait d'insérer une ligne en bas de tableau:
Private Sub Worksheet_Change(ByVal Target As Range)
' teste si la cellule juste au dessus est remplie
If Range("premiereCelluleApresTableau").Offset(-1) <> "" Then
' ajoute une ligne - la ligne s'insère au dessus
Application.EnableEvents = False ' pour ne pas se mordre la queue
Range("premiereCelluleApresTableau").EntireRow.Insert xlShiftDown
Application.EnableEvents = True
End If
End Sub
Voici le code qui me reportait les infos du site unique (au départ) de mon Active Sheet (DI), vers ma sheet/onglet de suivi (Suivi DI), et me vidait les cellules une fois que la Call "Sub Soumettre": était exécutée:
Sub Soumettre()
Dim lign As Variant
lign = Sheets("Suivi des D.I. Reçues & Travaux").Range("A65000").End(xlUp).Row
If Sheets("Suivi des D.I. Reçues & Travaux").Range("A" & lign).Value <> "" Then
Sheets("Suivi des D.I. Reçues & Travaux").Range("A" & lign + 1).Value = Sheets("Demande d'Intervention").Range("B47").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("B" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C47").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("F" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D8").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("G" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C16").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("H" & lign + 1).Value = Sheets("Demande d'Intervention").Range("G16").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("I" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D18").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("J" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C20").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("K" & lign + 1).Value = Sheets("Demande d'Intervention").Range("G28").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("L" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D22").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("M" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D12").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("N" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C33").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("O" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C31").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("P" & lign + 1).Value = "Superviseur Travaux"""
Sheets("Suivi des D.I. Reçues & Travaux").Range("Q" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C16").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("R" & lign + 1).Value = "En attente"
Sheets("Suivi des D.I. Reçues & Travaux").Range("S" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C10").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("T" & lign + 1).Value = Sheets("Demande d'Intervention").Range("H12").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("U" & lign + 1).Value = Sheets("Demande d'Intervention").Range("H14").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("V" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D14").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("W" & lign + 1).Value = Sheets("Demande d'Intervention").Range("B36").Value
End If
With Sheets("Demande d'Intervention")
Select Case .Range("C24").Value
Case "Routine (U3)": Sheets("Suivi des D.I. Reçues & Travaux").Range("C" & lign + 1) = 3
Case "Urgence (U2)": Sheets("Suivi des D.I. Reçues & Travaux").Range("C" & lign + 1) = 2
Case "Urgence opérationnelle (U1)": Sheets("Suivi des D.I. Reçues & Travaux").Range("C" & lign + 1) = 1
End Select
Select Case .Range("C26").Value
Case "Non-dangereux": Sheets("Suivi des D.I. Reçues & Travaux").Range("D" & lign + 1) = 3
Case "Dangereux": Sheets("Suivi des D.I. Reçues & Travaux").Range("D" & lign + 1) = 2
Case "Très dangereux": Sheets("Suivi des D.I. Reçues & Travaux").Range("D" & lign + 1) = 1
End Select
Select Case .Range("G26").Value
Case "Non-bloquant": Sheets("Suivi des D.I. Reçues & Travaux").Range("E" & lign + 1) = 3
Case "Bloquant": Sheets("Suivi des D.I. Reçues & Travaux").Range("E" & lign + 1) = 2
Case "Très bloquant": Sheets("Suivi des D.I. Reçues & Travaux").Range("E" & lign + 1) = 1
End Select
End With
If Sheets("Suivi des D.I. Reçues & Travaux").Range("A" & lign).Value <> "" Then
Sheets("Demande d'Intervention").Range("D8:E8").ClearContents
Sheets("Demande d'Intervention").Range("C10:H10").ClearContents
Sheets("Demande d'Intervention").Range("H12").ClearContents
Sheets("Demande d'Intervention").Range("D14:E14").ClearContents
Sheets("Demande d'Intervention").Range("H14").ClearContents
Sheets("Demande d'Intervention").Range("D18:E18").ClearContents
Sheets("Demande d'Intervention").Range("D22:H22").ClearContents
Sheets("Demande d'Intervention").Range("C24:E24").ClearContents
Sheets("Demande d'Intervention").Range("C26:D26").ClearContents
Sheets("Demande d'Intervention").Range("G26:H26").ClearContents
Sheets("Demande d'Intervention").Range("G28:H28").ClearContents
Sheets("Demande d'Intervention").Range("C31:E31").ClearContents
Sheets("Demande d'Intervention").Range("C33:E33").ClearContents
Sheets("Demande d'Intervention").Range("B36:H41").ClearContents
Sheets("Demande d'Intervention").Range("C47").Value = Sheets("Suivi des D.I. Reçues & Travaux").Range("B" & lign + 1) + 1
End If
L'idée est que ça puisse me faire le même boulot, mais que ça puisse me recopier l'ensemble des données de l'active sheet (DI-Demande d'Intervention) où la macro est exécutée...vers une sheet(onglet) spécifique, portant le même nom que le site qui sera sélectionné via une cellule à menu déroulant de l'active sheet , permettant de renvoyer les données vers l'onglet en question portant exactement le même nom que le site choisi.
Si il vous faut le code de la Sub Principale aussi, je n'hésiterai pas à vous le faire parvenir.
En vous remerciant par avance ;-)
Concernant le 2ème point (moins "urgent"), et qui concerne le passage sous messagerie Gmail, voici le code de la Sub Principal où est indiqué la partie relative à l'axe du Process de Thunderbird, qu'il faudrait réussir à adapter et à passer sous Gmail:
Sub Envoi_Mail_TB()
Dim ssRep As String, ssNomFic As String
ssRep = ThisWorkbook.Path
With Sheets("Demande d'Intervention")
ssNomFic = "DI-" & Format(.Range("B47"), "yyyymmdd") & "-" & Format(.Range("C47"), "0000") & ".pdf"
End With
yourmsgbox = MsgBox("Avez-vous bien rempli la totalité des informations nécessaires à votre 'Demande d'Intervention' afin de procéder à l'envoi et à la validation de celle-ci ? ", vbOKCancel + vbExclamation, "Demande de confirmation")
If yourmsgbox = vbCancel Then
Exit Sub
End If
If yourmsgbox = vbOK Then
Mail_TB ssRep, ssNomFic
Application.Wait (Now + TimeValue("0:00:10"))
Kill ssRep & "\" & ssNomFic
Application.SendKeys ("{NUMLOCK}"), True
End If
Call Soumettre
MsgBox "Votre Demande d'Intervention a bien été impactée. Afin de la valider totalement, vous pouvez maintenant fermer le fichier", vbOKOnly + vbExclamation, "Etape cruciale de fin de validation!"
End Sub
Private Sub Mail_TB(sRep As String, sNomFic As String)
Dim tTo As String, tCC As String, tBCC As String, tSujet As String, fichier As String
Dim objShell
Set objShell = CreateObject("WScript.Shell")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
strHtml = "Bonjour, </font></BR>"
strHtml = strHtml & "<BR>" & _
"Vous avez reçu une nouvelle Demande d'Intervention validée. </font></BR>"
strHtml = strHtml & "<BR>" & _
"Merci de bien vouloir la prendre en compte. </font></BR>"
strHtml = strHtml & "<BR>" & _
"<font color=black>Bien cordialement.</font>" & "<BR>"
strHtml = strHtml & "<BR>" & _
"<font color=blue>L'Équipe Travaux. </font>" & "<BR><BR>"
strHtml = strHtml & "<BR>" & _
"<I>Ceci est un email automatique. Merci de ne pas y répondre.</I>" & "</font></BR>"
strHtml = strHtml & "<BR>"
strHtml = strHtml & Environ("UserName")
strHtml = strHtml & ""
tTo = "XXXXXXX@gmail.com;xxxxxxxxxx@gmail.com;xxxxxxxxxxxxx@live.fr"
quoi = Sheets("Demande d'Intervention").Range("G28").Value
If quoi = "" Then
tCC = ""
Else
With Sheets("Table des matières")
tCC = Application.Index(.Range("G:G"), Application.Match(quoi, .Range("D:D"), 0))
End With
End If
tBCC = "xxxxxxxxxxxxxx@hotmail.fr"
tSujet = "Nouvelle Demande d'Intervention reçue"
fichier = sRep & "\" & sNomFic
x = Environ("PROCESSOR_ARCHITECTURE")
Select Case x
Case "x86": pgf = "%ProgramFiles%"
Case "AMD64": pgf = "%ProgramFiles(x86)%"
End Select
objShell.Exec ("" & pgf & "\Mozilla Thunderbird\thunderbird.exe -compose" & _
" preselectid='id1'" & _
",to='" & tTo & "'" & _
",cc='" & tCC & "'" & _
",bcc='" & tBCC & "'" & _
",newsgroups=''" & _
",subject='" & tSujet & "'" & _
",body='" & strHtml & "'" & _
",attachment='" & fichier & "'" & _
",bodyislink='false'" & _
",type='0'" & _
",format='1'" & _
",originalMsg=''" & _
"")
Application.Wait (Now + TimeValue("0:00:09"))
SendKeys "^{ENTER}", True
Set objShell = Nothing
End Sub
Bonjour,
tu es dans un rubrique Google Sheets et tu nous donnes un code VBA. Il vaudrait mieux que tu repostes dans la rubrique excel VBA.
Concernant le 2ème point (moins "urgent"), et qui concerne le passage sous messagerie Gmail, voici le code de la Sub Principal où est indiqué la partie relative à l'axe du Process de Thunderbird, qu'il faudrait réussir à adapter et à passer sous Gmail:
Impossible ... c'est comme si tu demandais de passer de Thunderbird à Orange. Tu as d'un côté un logiciel de messagerie implanté sur ton ordinateur (comme outlook, thunderbird, etc.) et de l'autre un serveur distant de messagerie électronique. D'un côté tu lances ton logiciel via objShell.Exec, de l'autre ce n'est pas possible car ce n'est pas un logiciel !
2 solutions :
- avec excel, utilises CDO comme tu le mentionnes, et rien n'empêche d'avoir sur chaque poste de travail un petit fichier texte avec les paramètres propres à chacun (à l'image de outlook, Thunderbird dont les paramètres spécifiques à l'émetteur sont sur son poste)
- passe complètement sous GSheets